section "QE lemmas" theory QE imports Polynomials.MPoly_Type_Univariate Polynomials.Polynomials Polynomials.MPoly_Type_Class_FMap "HOL-Library.Quadratic_Discriminant" begin (* This file may take some time to load *) subsection "Useful Definitions/Setting Up" definition sign:: "real Polynomial.poly ⇒ real ⇒ int" where "sign p x ≡ (if poly p x = 0 then 0 else (if poly p x > 0 then 1 else -1))" definition sign_num:: "real ⇒ int" where "sign_num x ≡ (if x = 0 then 0 else (if x > 0 then 1 else -1))" definition root_list:: "real Polynomial.poly ⇒ real set" where "root_list p ≡ ({(x::real). poly p x = 0}::real set)" definition root_set:: "(real × real × real) set ⇒ real set" where "root_set les ≡ ({(x::real). (∃ (a, b, c) ∈ les. a*x^2 + b*x + c = 0)}::real set)" definition sorted_root_list_set:: "(real × real × real) set ⇒ real list" where "sorted_root_list_set p ≡ sorted_list_of_set (root_set p)" definition nonzero_root_set:: "(real × real × real) set ⇒ real set" where "nonzero_root_set les ≡ ({(x::real). (∃ (a, b, c) ∈ les. (a ≠ 0 ∨ b ≠ 0) ∧ a*x^2 + b*x + c = 0)}::real set)" definition sorted_nonzero_root_list_set:: "(real × real × real) set ⇒ real list" where "sorted_nonzero_root_list_set p ≡ sorted_list_of_set (nonzero_root_set p)" (* Important property of sorted lists *) lemma sorted_list_prop: fixes l::"real list" fixes x::"real" assumes sorted: "sorted l" assumes lengt: "length l > 0" assumes xgt: "x > l ! 0" assumes xlt: "x ≤ l ! (length l - 1)" shows "∃n. (n+1) < (length l) ∧ x ≥ l !n ∧ x ≤ l ! (n + 1)" proof - have "¬(∃n. (n+1) < (length l) ∧ x ≥ l !n ∧ x ≤ l ! (n + 1)) ⟹ False" proof clarsimp fix n assume alln: "∀n. l ! n ≤ x ⟶ Suc n < length l ⟶ ¬ x ≤ l ! Suc n" have "∀k. (k < length l ⟶ x > l ! k)" proof clarsimp fix k show "k < length l ⟹ l ! k < x" proof (induct k) case 0 then show ?case using xgt by auto next case (Suc k) then show ?case using alln using less_eq_real_def by auto qed qed then show "False" using xlt diff_Suc_less lengt not_less by (metis One_nat_def) qed then show ?thesis by auto qed subsection "Quadratic polynomial properties" lemma quadratic_poly_eval: fixes a b c::"real" fixes x::"real" shows "poly [:c, b, a:] x = a*x^2 + b*x + c" proof - have "x * (b + x * a) = a * x⇧2 + b * x" by (metis add.commute distrib_right mult.assoc mult.commute power2_eq_square) then show ?thesis by auto qed lemma poly_roots_set_same: fixes a b c:: "real" shows "{(x::real). a * x⇧2 + b * x + c = 0} = {x. poly [:c, b, a:] x = 0}" proof - have "∀x. a*x^2 + b*x + c = poly [:c, b, a:] x" proof clarsimp fix x show "a * x⇧2 + b * x = x * (b + x * a)" using quadratic_poly_eval[of c b a x] by auto qed then show ?thesis by auto qed lemma root_set_finite: assumes fin: "finite les" assumes nex: "¬(∃ (a, b, c) ∈ les. a = 0 ∧ b = 0 ∧ c = 0 )" shows "finite (root_set les)" proof - have "∀(a, b, c) ∈ les. finite {(x::real). a*x^2 + b*x + c = 0}" proof clarsimp fix a b c assume "(a, b, c) ∈ les" then have "[:c, b, a:] ≠ 0" using nex by auto then have "finite {x. poly [:c, b, a:] x = 0}" using poly_roots_finite[where p = "[:c, b, a:]"] by auto then show "finite {x. a * x⇧2 + b * x + c = 0}" using poly_roots_set_same by auto qed then show ?thesis using fin unfolding root_set_def by auto qed lemma nonzero_root_set_finite: assumes fin: "finite les" shows "finite (nonzero_root_set les)" proof - have "∀(a, b, c) ∈ les. (a ≠ 0 ∨ b ≠ 0) ⟶ finite {(x::real). a*x^2 + b*x + c = 0}" proof clarsimp fix a b c assume ins: "(a, b, c) ∈ les" assume "a = 0 ⟶ b ≠ 0" then have "[:c, b, a:] ≠ 0" using ins by auto then have "finite {x. poly [:c, b, a:] x = 0}" using poly_roots_finite[where p = "[:c, b, a:]"] by auto then show "finite {x. a * x⇧2 + b * x + c = 0}" using poly_roots_set_same by auto qed then show ?thesis using fin unfolding nonzero_root_set_def by auto qed lemma discriminant_lemma: fixes a b c r::"real" assumes aneq: "a ≠ 0" assumes beq: "b = 2 * a * r" assumes root: " a * r^2 - 2 * a * r*r + c = 0" shows "∀x. a * x⇧2 + b * x + c = 0 ⟷ x = -r" proof - have "c = a*r^2" using root by (simp add: power2_eq_square) then have same: "b^2 - 4*a*c = (2 * a * r)^2 - 4*a*(a*r^2)" using beq by blast have "(2 * a * r)^2 = 4*a^2*r^2" by (simp add: mult.commute power2_eq_square) then have "(2 * a * r)^2 - 4*a*(a*(r)^2) = 0" using power2_eq_square by auto then have "b^2 - 4*a*c = 0" using same by simp then have "∀x. a * x⇧2 + b * x + c = 0 ⟷ x = -b / (2 * a)" using discriminant_zero aneq unfolding discrim_def by auto then show ?thesis using beq by (simp add: aneq) qed (* Show a polynomial only changes sign when it passes through a root *) lemma changes_sign: fixes p:: "real Polynomial.poly" shows "∀x::real. ∀ y::real. ((sign p x ≠ sign p y ∧ x < y) ⟶ (∃c ∈ (root_list p). x ≤ c ∧ c ≤ y))" proof clarsimp fix x y assume "sign p x ≠ sign p y" assume "x < y" then show "∃c∈root_list p. x ≤ c ∧ c ≤ y" using poly_IVT_pos[of x y p] poly_IVT_neg[of x y p] by (metis (mono_tags) ‹sign p x ≠ sign p y› less_eq_real_def linorder_neqE_linordered_idom mem_Collect_eq root_list_def sign_def) qed (* Show a polynomial only changes sign if it passes through a root *) lemma changes_sign_var: fixes a b c x y:: "real" shows "((sign_num (a*x^2 + b*x + c) ≠ sign_num (a*y^2 + b*y + c) ∧ x < y) ⟹ (∃q. (a*q^2 + b*q + c = 0 ∧ x ≤ q ∧ q ≤ y)))" proof clarsimp assume sn: "sign_num (a * x⇧2 + b * x + c) ≠ sign_num (a * y⇧2 + b * y + c)" assume xy: " x < y" let ?p = "[:c, b, a:]" have cs: "((sign ?p x ≠ sign ?p y ∧ x < y) ⟶ (∃c ∈ (root_list ?p). x ≤ c ∧ c ≤ y))" using changes_sign[of ?p] by auto have "(sign ?p x ≠ sign ?p y ∧ x < y)" using sn xy unfolding sign_def sign_num_def using quadratic_poly_eval by presburger then have "(∃c ∈ (root_list ?p). x ≤ c ∧ c ≤ y)" using cs by auto then obtain q where "q ∈ root_list ?p ∧ x ≤ q ∧ q ≤ y" by auto then have "a*q^2 + b*q + c = 0 ∧ x ≤ q ∧ q ≤ y" unfolding root_list_def using quadratic_poly_eval[of c b a q] by auto then show "∃q. a * q⇧2 + b * q + c = 0 ∧ x ≤ q ∧ q ≤ y" by auto qed subsection "Continuity Properties" lemma continuity_lem_eq0: fixes p::"real" shows "r < p ⟹ ∀x∈{r <..p}. a * x⇧2 + b * x + c = 0 ⟹ (a = 0 ∧ b = 0 ∧ c = 0)" proof - assume r_lt: "r < p" assume inf_zer: "∀x∈{r <..p}. a * x⇧2 + b * x + c = 0" have nf: "¬finite {r..<p}" using Set_Interval.dense_linorder_class.infinite_Ioo r_lt by auto have "¬(a = 0 ∧ b = 0 ∧ c = 0) ⟹ False" proof - assume "¬(a = 0 ∧ b = 0 ∧ c = 0)" then have "[:c, b, a:] ≠ 0" by auto then have fin: "finite {x. poly [:c, b, a:] x = 0}" using poly_roots_finite[where p = "[:c, b, a:]"] by auto have "{x. a*x^2 + b*x + c = 0} = {x. poly [:c, b, a:] x = 0}" using quadratic_poly_eval by auto then have finset: "finite {x. a*x^2 + b*x + c = 0}" using fin by auto have "{r <..p} ⊆ {x. a*x^2 + b*x + c = 0}" using inf_zer by blast then show "False" using finset nf using finite_subset by (metis (no_types, lifting) infinite_Ioc_iff r_lt) qed then show "(a = 0 ∧ b = 0 ∧ c = 0)" by auto qed lemma continuity_lem_lt0: fixes r:: "real" fixes a b c:: "real" shows "poly [:c, b, a:] r < 0 ⟹ ∃y'> r. ∀x∈{r<..y'}. poly [:c, b, a:] x < 0" proof - let ?f = "poly [:c,b,a:]" assume r_ltz: "poly [:c, b, a:] r < 0" then have "[:c, b, a:] ≠ 0" by auto then have "finite {x. poly [:c, b, a:] x = 0}" using poly_roots_finite[where p = "[:c, b, a:]"] by auto then have fin: "finite {x. x > r ∧ poly [:c, b, a:] x = 0}" using finite_Collect_conjI by blast let ?l = "sorted_list_of_set {x. x > r ∧ poly [:c, b, a:] x = 0}" show ?thesis proof (cases "length ?l = 0") case True then have no_zer: "¬(∃x>r. poly [:c, b, a:] x = 0)" using sorted_list_of_set_eq_Nil_iff fin by auto then have "⋀y. y > r ∧ y < (r + 1) ⟹ poly [:c, b, a:] y < 0 " proof - fix y assume "y > r ∧ y < r + 1" then show "poly [:c, b, a:] y < 0" using r_ltz no_zer poly_IVT_pos[where a = "r", where p = "[:c, b, a:]", where b = "y"] by (meson linorder_neqE_linordered_idom) qed then show ?thesis by (metis (no_types, hide_lams) ‹¬ (∃x>r. poly [:c, b, a:] x = 0)› ‹poly [:c, b, a:] r < 0› greaterThanAtMost_iff linorder_neqE_linordered_idom linordered_field_no_ub poly_IVT_pos) next case False then have len_nonz: "length (sorted_list_of_set {x. r < x ∧ poly [:c, b, a:] x = 0}) ≠ 0" by blast then have "∀n ∈ {x. x > r ∧ poly [:c, b, a:] x = 0}. (nth_default 0 ?l 0) ≤ n" using fin set_sorted_list_of_set sorted_sorted_list_of_set using in_set_conv_nth leI not_less0 sorted_nth_mono by (smt not_less_iff_gr_or_eq nth_default_def) then have no_zer: "¬(∃x>r. (x < (nth_default 0 ?l 0) ∧ poly [:c, b, a:] x = 0))" using sorted_sorted_list_of_set by auto then have fa: "⋀y. y > r ∧ y < (nth_default 0 ?l 0) ⟹ poly [:c, b, a:] y < 0 " proof - fix y assume "y > r ∧ y < (nth_default 0 ?l 0)" then show "poly [:c, b, a:] y < 0" using r_ltz no_zer poly_IVT_pos[where a = "r", where p = "[:c, b, a:]", where b = "y"] by (meson less_imp_le less_le_trans linorder_neqE_linordered_idom) qed have "nth_default 0 ?l 0 > r" using fin set_sorted_list_of_set using len_nonz length_0_conv length_greater_0_conv mem_Collect_eq nth_mem by (metis (no_types, lifting) nth_default_def) then have "∃(y'::real). r < y' ∧ y' < (nth_default 0 ?l 0)" using dense by blast then obtain y' where y_prop:"r < y' ∧y' < (nth_default 0 ?l 0)" by auto then have "∀x∈{r<..y'}. poly [:c, b, a:] x < 0" using fa by auto then show ?thesis using y_prop by blast qed qed lemma continuity_lem_gt0: fixes r:: "real" fixes a b c:: "real" shows "poly [:c, b, a:] r > 0 ⟹ ∃y'> r. ∀x∈{r<..y'}. poly [:c, b, a:] x > 0" proof - assume r_gtz: "poly [:c, b, a:] r > 0 " let ?p = "[:-c, -b, -a:]" have revpoly: "∀x. -1*(poly [:c, b, a:] x) = poly [:-c, -b, -a:] x" by (metis (no_types, hide_lams) Polynomial.poly_minus add.inverse_neutral minus_pCons mult_minus1) then have "poly ?p r < 0" using r_gtz by (metis mult_minus1 neg_less_0_iff_less) then have "∃y'> r. ∀x∈{r<..y'}. poly ?p x < 0" using continuity_lem_lt0 by blast then obtain y' where y_prop: "y' > r ∧ (∀x∈{r<..y'}. poly ?p x < 0)" by auto then have "∀x∈{r<..y'}. poly [:c, b, a:] x > 0 " using revpoly using neg_less_0_iff_less by fastforce then show ?thesis using y_prop by blast qed lemma continuity_lem_lt0_expanded: fixes r:: "real" fixes a b c:: "real" shows "a*r^2 + b*r + c < 0 ⟹ ∃y'> r. ∀x∈{r<..y'}. a*x^2 + b*x + c < 0" using quadratic_poly_eval continuity_lem_lt0 by (simp add: add.commute) lemma continuity_lem_gt0_expanded: fixes r:: "real" fixes a b c:: "real" fixes k::"real" assumes kgt: "k > r" shows "a*r^2 + b*r + c > 0 ⟹ ∃x∈{r<..k}. a*x^2 + b*x + c > 0" proof - assume "a*r^2 + b*r + c > 0" then have "∃y'> r. ∀x∈{r<..y'}. poly [:c, b, a:] x > 0" using continuity_lem_gt0 quadratic_poly_eval[of c b a r] by auto then obtain y' where y_prop: "y' > r ∧ (∀x∈{r<..y'}. poly [:c, b, a:] x > 0)" by auto then have "∃q. q > r ∧ q < min k y'" using kgt dense by (metis min_less_iff_conj) then obtain q where q_prop: "q > r ∧q < min k y'" by auto then have "a*q^2 + b*q + c > 0" using y_prop quadratic_poly_eval[of c b a q] by (metis greaterThanAtMost_iff less_eq_real_def min_less_iff_conj) then show ?thesis using q_prop by auto qed subsection "Negative Infinity (Limit) Properties" lemma ysq_dom_y: fixes b:: "real" fixes c:: "real" shows "∃(w::real). ∀(y:: real). (y < w ⟶ y^2 > b*y)" proof - have c1: "b ≥ 0 ==> ∃(w::real). ∀(y:: real). (y < w ⟶ y^2 > b*y)" proof - assume "b ≥ 0" then have p1: "∀(y:: real). (y < -1 ⟶ y*b ≤ 0)" by (simp add: mult_nonneg_nonpos2) have p2: "∀(y:: real). (y < -1 ⟶ y^2 > 0)" by auto then have h1: "∀(y:: real). (y < -1 ⟶ y^2 > b*y)" using p1 p2 by (metis less_eq_real_def less_le_trans mult.commute) then show ?thesis by auto qed have c2: "b < 0 ∧ b > -1 ==> ∃(w::real). ∀(y:: real). (y < w ⟶ y^2 > b*y)" proof - assume "b < 0 ∧ b > -1 " then have h1: "∀(y:: real). (y < -1 ⟶ y^2 > b*y)" by (simp add: power2_eq_square) then show ?thesis by auto qed have c3: "b ≤ -1 ==> ∃(w::real). ∀(y:: real). (y < w ⟶ y^2 > b*y)" proof - assume "b ≤ -1 " then have h1: "∀(y:: real). (y < b ⟶ y^2 > b*y)" by (metis le_minus_one_simps(3) less_irrefl less_le_trans mult.commute mult_less_cancel_left power2_eq_square) then show ?thesis by auto qed then show ?thesis using c1 c2 c3 by (metis less_trans linorder_not_less) qed lemma ysq_dom_y_plus_coeff: fixes b:: "real" fixes c:: "real" shows "∃(w::real). ∀(y::real). (y < w ⟶ y^2 > b*y + c)" proof - have "∃(w::real). ∀(y:: real). (y < w ⟶ y^2 > b*y)" using ysq_dom_y by auto then obtain w where w_prop: "∀(y:: real). (y < w ⟶ y^2 > b*y)" by auto have "c ≤ 0 ⟹ ∀(y::real). (y < w ⟶ y^2 > b*y + c)" using w_prop by auto then have c1: "c ≤ 0 ⟹ ∃(w::real). ∀(y::real). (y < w ⟶ y^2 > b*y + c)" by auto have "∃(w::real). ∀(y:: real). (y < w ⟶ y^2 > (b-c)*y)" using ysq_dom_y by auto then obtain k where k_prop: "∀(y:: real). (y < k ⟶ y^2 > (b-c)*y)" by auto let ?mn = "min k (-1)" have "(c> 0 ⟹ (∀ y < -1. -c*y > c))" proof - assume cgt: " c> 0" show "∀(y::real) < -1. -c*y > c" proof clarsimp fix y::"real" assume "y < -1" then have "-y > 1" by auto then have "c < c*(-y)" using cgt by (metis ‹1 < - y› mult.right_neutral mult_less_cancel_left_pos) then show " c < - (c * y) " by auto qed qed then have "(c> 0 ⟶ (∀ y < ?mn. (b-c)*y > b*y + c))" by (simp add: left_diff_distrib) then have c2: "c > 0 ⟹ ∀(y::real). (y < ?mn ⟶ y^2 > b*y + c)" using k_prop by force then have c2: "c > 0 ⟹ ∃(w::real). ∀(y::real). (y < w ⟶ y^2 > b*y + c)" by blast show ?thesis using c1 c2 by fastforce qed lemma ysq_dom_y_plus_coeff_2: fixes b:: "real" fixes c:: "real" shows "∃(w::real). ∀(y::real). (y > w ⟶ y^2 > b*y + c)" proof - have "∃(w::real). ∀(y::real). (y < w ⟶ y^2 > -b*y + c)" using ysq_dom_y_plus_coeff[where b = "-b", where c = "c"] by auto then obtain w where w_prop: "∀(y::real). (y < w ⟶ y^2 > -b*y + c)" by auto let ?mn = "min w (-1)" have "∀(y::real). (y < ?mn ⟶ y^2 > -b*y + c)" using w_prop by auto then have "∀(y::real). (y > (-1*?mn) ⟶ y^2 > b*y + c)" by (metis (no_types, hide_lams) add.inverse_inverse minus_less_iff mult_minus1 mult_minus_left mult_minus_right power2_eq_square) then show ?thesis by auto qed lemma neg_lc_dom_quad: fixes a:: "real" fixes b:: "real" fixes c:: "real" assumes alt: "a < 0" shows "∃(w::real). ∀(y::real). (y > w ⟶ a*y^2 + b*y + c < 0)" proof - have "∃(w::real). ∀(y::real). (y > w ⟶ y^2 > (-b/a)*y + (-c/a))" using ysq_dom_y_plus_coeff_2[where b = "-b/a", where c = "-c/a"] by auto then have keyh: "∃(w::real). ∀(y::real). (y > w ⟶ a*y^2 < a*((-b/a)*y + (-c/a)))" using alt by auto have simp1: "∀y. a*((-b/a)*y + (-c/a)) = a*(-b/a)*y + a*(-c/a)" using diff_divide_eq_iff by fastforce have simp2: "∀y. a*(-b/a)*y + a*(-c/a) = -b*y + a*(-c/a)" using assms by auto have simp3: "∀y. -b*y + a*(-c/a) = -b*y - c" using assms by auto then have "∀y. a*((-b/a)*y + (-c/a)) = -b*y - c" using simp1 simp2 simp3 by auto then have keyh2: "∃(w::real). ∀(y::real). (y > w ⟶ a*y^2 < -b*y-c)" using keyh by auto have "∀y. a*y^2 < -b*y-c ⟷ a*y^2 + b*y + c < 0" by auto then show ?thesis using keyh2 by auto qed lemma pos_lc_dom_quad: fixes a:: "real" fixes b:: "real" fixes c:: "real" assumes alt: "a > 0" shows "∃(w::real). ∀(y::real). (y > w ⟶ a*y^2 + b*y + c > 0)" proof - have "-a < 0" using alt by simp then have "∃(w::real). ∀(y::real). (y > w ⟶ -a*y^2 - b*y - c < 0)" using neg_lc_dom_quad[where a = "-a", where b = "-b", where c = "-c"] by auto then obtain w where w_prop: "∀(y::real). (y > w ⟶ -a*y^2 - b*y - c < 0)" by auto then have "∀(y::real). (y > w ⟶ a*y^2 + b*y + c > 0)" by auto then show ?thesis by auto qed (* lemma interval_infinite: fixes r p::"real" assumes "r < p" shows "infinite {r<..<p}" using Set_Interval.dense_linorder_class.infinite_Ioo using assms by blast *) subsection "Infinitesimal and Continuity Properties" lemma les_qe_inf_helper: fixes q:: "real" shows"(∀(d, e, f)∈set les. ∃y'> q. ∀x∈{q<..y'}. d * x⇧2 + e * x + f < 0) ⟹ (∃y'>q. (∀(d, e, f)∈set les. ∀x∈{q<..y'}. d * x⇧2 + e * x + f < 0))" proof (induct les) case Nil then show ?case using gt_ex by auto next case (Cons z les) have "∀a∈set les. case a of (d, e, f) ⇒ ∃y'>q. ∀x∈{q<..y'}. d * x⇧2 + e * x + f < 0" using Cons.prems by auto then have " ∃y'>q. ∀a∈set les. case a of (d, e, f) ⇒ ∀x∈{q<..y'}. d * x⇧2 + e * x + f < 0" using Cons.hyps by auto then obtain y1 where y1_prop : "y1>q ∧ (∀a∈set les. case a of (d, e, f) ⇒ ∀x∈{q<..y1}. d * x⇧2 + e * x + f < 0)" by auto have "case z of (d, e, f) ⇒ ∃y'>q. ∀x∈{q<..y'}. d * x⇧2 + e * x + f < 0" using Cons.prems by auto then obtain y2 where y2_prop: "y2>q ∧ (case z of (d, e, f) ⇒ (∀x∈{q<..y2}. d * x⇧2 + e * x + f < 0))" by auto let ?y = "min y1 y2" have "?y > q ∧ (∀a∈set (z#les). case a of (d, e, f) ⇒ ∀x∈{q<..?y}. d * x⇧2 + e * x + f < 0)" using y1_prop y2_prop by force then show ?case by blast qed lemma have_inbetween_point_les: fixes r::"real" assumes "(∀(d, e, f)∈set les. ∃y'>r. ∀x∈{r<..y'}. d * x⇧2 + e * x + f < 0)" shows "(∃x. (∀(a, b, c)∈set les. a * x⇧2 + b * x + c < 0))" proof - have "(∀(d, e, f)∈set les. ∃y'>r. ∀x∈{r<..y'}. d * x⇧2 + e * x + f < 0) ⟹ (∃y'>r. (∀(d, e, f)∈set les. ∀x∈{r<..y'}. d * x⇧2 + e * x + f < 0))" using les_qe_inf_helper assms by auto then have "(∃y'>r. (∀(d, e, f)∈set les. ∀x∈{r<..y'}. d * x⇧2 + e * x + f < 0))" using assms by blast then obtain y where y_prop: "y > r ∧ (∀(d, e, f)∈set les. ∀x∈{r<..y}. d * x⇧2 + e * x + f < 0)" by auto have "∃q. q > r ∧q < y" using y_prop dense by auto then obtain q where q_prop: "q > r ∧ q < y" by auto then have "(∀(d, e, f)∈set les. d*q^2 + e*q + f < 0)" using y_prop by auto then show ?thesis by auto qed lemma one_root_a_gt0: fixes a b c r:: "real" shows "⋀y'. b = 2 * a * r ⟹ ¬ a < 0 ⟹ a * r^2 - 2 * a *r*r + c = 0 ⟹ - r < y' ⟹ ∃x∈{-r<..y'}. ¬ a * x⇧2 + 2 * a * r*x + c < 0" proof - fix y' assume beq: "b = 2 * a * r" assume aprop: " ¬ a < 0" assume root: " a * r⇧2 - 2 * a *r*r + c = 0" assume rootlt: "- r < y'" show " ∃x∈{- r<..y'}. ¬ a * x⇧2 + 2 * a* r*x+ c < 0" proof - have h: "a = 0 ⟹ (b = 0 ∧ c = 0)" using beq root by auto then have aeq: "a = 0 ⟹ ∃x∈{- r<..y'}. ¬ a * x⇧2 + 2 * a*r*x + c < 0" using rootlt by (metis add.left_neutral continuity_lem_eq0 less_numeral_extra(3) mult_zero_left mult_zero_right) then have alt: "a > 0 ⟹ ∃x∈{- r<..y'}. ¬ a * x⇧2 + 2 * a *r*x + c < 0" proof - assume agt: "a > 0" then have "∃(w::real). ∀(y::real). (y > w ⟶ a*y^2 + b*y + c > 0)" using pos_lc_dom_quad by auto then obtain w where w_prop: "∀y::real. (y > w ⟶ a*y^2 + b*y + c > 0)" by auto have isroot: "a*(-r)^2 + b*(-r) + c = 0" using root beq by auto then have wgteq: "w ≥ -(r)" proof - have "w < -r ⟹ False" using w_prop isroot by auto then show ?thesis using not_less by blast qed then have w1: "w + 1 > -r" by auto have w2: "a*(w + 1)^2 + b*(w+1) + c > 0" using w_prop by auto have rootiff: "∀x. a * x⇧2 + b * x + c = 0 ⟷ x = -r" using discriminant_lemma[where a = "a", where b = "b", where c= "c", where r = "r"] isroot agt beq by auto have allgt: "∀x > -r. a*x^2 + b*x + c > 0" proof clarsimp fix x assume "x > -r" have xgtw: "x > w + 1 ⟹ a*x^2 + b*x + c > 0 " using w1 w2 rootiff poly_IVT_neg[where a = "w+1", where b = "x", where p = "[:c,b,a:]"] quadratic_poly_eval by (metis less_eq_real_def linorder_not_less) have xltw: "x < w + 1 ⟹ a*x^2 + b*x + c > 0" using w1 w2 rootiff poly_IVT_pos[where a= "x", where b = "w + 1", where p = "[:c,b,a:]"] quadratic_poly_eval less_eq_real_def linorder_not_less by (metis ‹- r < x›) then show "a*x^2 + b*x + c > 0" using w2 xgtw xltw by fastforce qed have "∃z. z > -r ∧ z < y'" using rootlt dense[where x = "-r", where y = "y'"] by auto then obtain z where z_prop: " z > -r ∧ z < y'" by auto then have "a*z^2 + b*z + c > 0" using allgt by auto then show ?thesis using z_prop using beq greaterThanAtMost_iff by force qed then show ?thesis using aeq alt aprop by linarith qed qed lemma leq_qe_inf_helper: fixes q:: "real" shows"(∀(d, e, f)∈set leq. ∃y'> q. ∀x∈{q<..y'}. d * x⇧2 + e * x + f ≤ 0) ⟹ (∃y'>q. (∀(d, e, f)∈set leq. ∀x∈{q<..y'}. d * x⇧2 + e * x + f ≤ 0))" proof (induct leq) case Nil then show ?case using gt_ex by auto next case (Cons z leq) have "∀a∈set leq. case a of (d, e, f) ⇒ ∃y'>q. ∀x∈{q<..y'}. d * x⇧2 + e * x + f ≤ 0" using Cons.prems by auto then have " ∃y'>q. ∀a∈set leq. case a of (d, e, f) ⇒ ∀x∈{q<..y'}. d * x⇧2 + e * x + f ≤ 0" using Cons.hyps by auto then obtain y1 where y1_prop : "y1>q ∧ (∀a∈set leq. case a of (d, e, f) ⇒ ∀x∈{q<..y1}. d * x⇧2 + e * x + f ≤ 0)" by auto have "case z of (d, e, f) ⇒ ∃y'>q. ∀x∈{q<..y'}. d * x⇧2 + e * x + f ≤ 0" using Cons.prems by auto then obtain y2 where y2_prop: "y2>q ∧ (case z of (d, e, f) ⇒ (∀x∈{q<..y2}. d * x⇧2 + e * x + f ≤ 0))" by auto let ?y = "min y1 y2" have "?y > q ∧ (∀a∈set (z#leq). case a of (d, e, f) ⇒ ∀x∈{q<..?y}. d * x⇧2 + e * x + f ≤ 0)" using y1_prop y2_prop by force then show ?case by blast qed lemma neq_qe_inf_helper: fixes q:: "real" shows"(∀(d, e, f)∈set neq. ∃y'> q. ∀x∈{q<..y'}. d * x⇧2 + e * x + f ≠ 0) ⟹ (∃y'>q. (∀(d, e, f)∈set neq. ∀x∈{q<..y'}. d * x⇧2 + e * x + f ≠ 0))" proof (induct neq) case Nil then show ?case using gt_ex by auto next case (Cons z neq) have "∀a∈set neq. case a of (d, e, f) ⇒ ∃y'>q. ∀x∈{q<..y'}. d * x⇧2 + e * x + f ≠ 0" using Cons.prems by auto then have " ∃y'>q. ∀a∈set neq. case a of (d, e, f) ⇒ ∀x∈{q<..y'}. d * x⇧2 + e * x + f ≠ 0" using Cons.hyps by auto then obtain y1 where y1_prop : "y1>q ∧ (∀a∈set neq. case a of (d, e, f) ⇒ ∀x∈{q<..y1}. d * x⇧2 + e * x + f ≠ 0)" by auto have "case z of (d, e, f) ⇒ ∃y'>q. ∀x∈{q<..y'}. d * x⇧2 + e * x + f ≠ 0" using Cons.prems by auto then obtain y2 where y2_prop: "y2>q ∧ (case z of (d, e, f) ⇒ (∀x∈{q<..y2}. d * x⇧2 + e * x + f ≠ 0))" by auto let ?y = "min y1 y2" have "?y > q ∧ (∀a∈set (z#neq). case a of (d, e, f) ⇒ ∀x∈{q<..?y}. d * x⇧2 + e * x + f ≠ 0)" using y1_prop y2_prop by force then show ?case by blast qed subsection "Some Casework" lemma quadratic_shape1a: fixes a b c x y::"real" assumes agt: "a > 0" assumes xyroots: "x < y ∧ a*x^2 + b*x + c = 0 ∧ a*y^2 + b*y + c = 0" shows "⋀z. (z > x ∧ z < y ⟹ a*z^2 + b*z + c < 0)" proof clarsimp fix z assume zgt: "z > x" assume zlt: "z < y" have frac_gtz: "(1/(2*a)) > 0" using agt by simp have xy_prop:"(x = (-b + sqrt(b^2 - 4*a*c))/(2*a) ∧ y = (-b - sqrt(b^2 - 4*a*c))/(2*a)) ∨ (y = (-b + sqrt(b^2 - 4*a*c))/(2*a) ∧ x = (-b - sqrt(b^2 - 4*a*c))/(2*a))" using xyroots agt discriminant_iff unfolding discrim_def by auto have "b^2 - 4*a*c ≥ 0" using xyroots discriminant_iff using assms(1) discrim_def by auto then have pos_discrim: "b^2 - 4*a*c > 0" using xyroots discriminant_zero using ‹0 ≤ b⇧2 - 4 * a * c› assms(1) discrim_def less_eq_real_def linorder_not_less by metis then have sqrt_gt: "sqrt(b^2 - 4*a*c) > 0" using real_sqrt_gt_0_iff by blast then have "(- b - sqrt(b^2 - 4*a*c)) < (- b + sqrt(b^2 - 4*a*c))" by auto then have "(- b - sqrt(b^2 - 4*a*c))*(1/(2*a)) < (- b + sqrt(b^2 - 4*a*c))*(1/(2*a)) " using frac_gtz by (simp add: divide_strict_right_mono) then have "(- b - sqrt(b^2 - 4*a*c))/(2*a) < (- b + sqrt(b^2 - 4*a*c))/(2*a)" by auto then have xandy: "x = (- b - sqrt(b^2 - 4*a*c))/(2*a) ∧ y = (- b + sqrt(b^2 - 4*a*c))/(2*a)" using xy_prop xyroots by auto let ?mdpt = "-b/(2*a)" have xlt: "x < ?mdpt" using xandy sqrt_gt using frac_gtz divide_minus_left divide_strict_right_mono sqrt_gt by (smt (verit) agt) have ylt: "?mdpt < y" using xandy sqrt_gt frac_gtz by (smt (verit, del_insts) divide_strict_right_mono zero_less_divide_1_iff) have mdpt_val: "a*?mdpt^2 + b*?mdpt + c < 0" proof - have firsteq: "a*?mdpt^2 + b*?mdpt + c = (a*b^2)/(4*a^2) - (b^2)/(2*a) + c" by (simp add: power2_eq_square) have h1: "(a*b^2)/(4*a^2) = (b^2)/(4*a)" by (simp add: power2_eq_square) have h2: "(b^2)/(2*a) = (2*b^2)/(4*a)" by linarith have h3: "c = (4*a*c)/(4*a)" using agt by auto have "a*?mdpt^2 + b*?mdpt + c = (b^2)/(4*a) - (2*b^2)/(4*a) + (4*a*c)/(4*a) " using firsteq h1 h2 h3 by linarith then have "a*?mdpt^2 + b*?mdpt + c = (b^2 - 2*b^2 + 4*a*c)/(4*a)" by (simp add: diff_divide_distrib) then have eq2: "a*?mdpt^2 + b*?mdpt + c = (4*a*c - b^2)/(4*a)" by simp have h: "4*a*c - b^2 < 0" using pos_discrim by auto have "1/(4*a) > 0" using agt by auto then have "(4*a*c - b^2)*(1/(4*a)) < 0" using h using mult_less_0_iff by blast then show ?thesis using eq2 by auto qed have nex: "¬ (∃k> x. k < y ∧ poly [:c, b, a:] k = 0)" using discriminant_iff agt by (metis (no_types, hide_lams) discrim_def order_less_irrefl quadratic_poly_eval xandy) have nor2: "¬ (∃x>z. x < - b / (2 * a) ∧ poly [:c, b, a:] x = 0)" using nex xlt ylt zgt zlt by auto have nor: "¬ (∃x>- b / (2 * a). x < z ∧ poly [:c, b, a:] x = 0)" using nex xlt ylt zgt zlt discriminant_iff agt by auto then have mdpt_lt: "?mdpt < z ⟹ a*z^2 + b*z + c < 0 " using mdpt_val zgt zlt xlt ylt poly_IVT_pos[where p = "[:c, b, a:]", where a= "?mdpt", where b = "z"] quadratic_poly_eval[of c b a] by (metis ‹¬ (∃k>x. k < y ∧ poly [:c, b, a:] k = 0)› linorder_neqE_linordered_idom) have mdpt_gt: "?mdpt > z ⟹ a*z^2 + b*z + c < 0 " using zgt zlt mdpt_val xlt ylt nor2 poly_IVT_neg[where p = "[:c, b, a:]", where a = "z", where b = "?mdpt"] quadratic_poly_eval[of c b a] by (metis linorder_neqE_linordered_idom nex) then show "a*z^2 + b*z + c < 0" using mdpt_lt mdpt_gt mdpt_val by fastforce qed lemma quadratic_shape1b: fixes a b c x y::"real" assumes agt: "a > 0" assumes xy_roots: "x < y ∧ a*x^2 + b*x + c = 0 ∧ a*y^2 + b*y + c = 0" shows "⋀z. (z > y ⟹ a*z^2 + b*z + c > 0)" proof - fix z assume z_gt :"z > y" have nogt: "¬(∃w. w > y ∧ a*w^2 + b*w + c = 0)" using xy_roots discriminant_iff by (metis agt less_eq_real_def linorder_not_less) have "∃(w::real). ∀(y::real). (y > w ⟶ a*y^2 + b*y + c > 0)" using agt pos_lc_dom_quad by auto then have "∃k > y. a*k^2 + b*k + c > 0" by (metis add.commute agt less_add_same_cancel1 linorder_neqE_linordered_idom pos_add_strict) then obtain k where k_prop: "k > y ∧ a*k^2 + b*k + c > 0" by auto have kgt: "k > z ⟹ a*z^2 + b*z + c > 0" proof - assume kgt: "k > z" then have zneq: "a*z^2 + b*z + c = 0 ⟹ False" using nogt using z_gt by blast have znlt: "a*z^2 + b*z + c < 0 ⟹ False" using kgt k_prop quadratic_poly_eval[of c b a] z_gt nogt poly_IVT_pos[where a= "z", where b = "k", where p = "[:c, b, a:]"] by (metis less_eq_real_def less_le_trans) then show "a*z^2 + b*z + c > 0" using zneq znlt using linorder_neqE_linordered_idom by blast qed have klt: "k < z ⟹ a*z^2 + b*z + c > 0" proof - assume klt: "k < z" then have zneq: "a*z^2 + b*z + c = 0 ⟹ False" using nogt using z_gt by blast have znlt: "a*z^2 + b*z + c < 0 ⟹ False" using klt k_prop quadratic_poly_eval[of c b a] z_gt nogt poly_IVT_neg[where a= "k", where b = "z", where p = "[:c, b, a:]"] by (metis add.commute add_less_cancel_left add_mono_thms_linordered_field(3) less_eq_real_def) then show "a*z^2 + b*z + c > 0" using zneq znlt using linorder_neqE_linordered_idom by blast qed then show "a*z^2 + b*z + c > 0" using k_prop kgt klt by fastforce qed lemma quadratic_shape2a: fixes a b c x y::"real" assumes "a < 0" assumes "x < y ∧ a*x^2 + b*x + c = 0 ∧ a*y^2 + b*y + c = 0" shows "⋀z. (z > x ∧ z < y ⟹ a*z^2 + b*z + c > 0)" using quadratic_shape1a[where a= "-a", where b = "-b", where c = "-c", where x = "x", where y = "y"] using assms(1) assms(2) by fastforce lemma quadratic_shape2b: fixes a b c x y::"real" assumes "a < 0" assumes "x < y ∧ a*x^2 + b*x + c = 0 ∧ a*y^2 + b*y + c = 0" shows "⋀z. (z > y ⟹ a*z^2 + b*z + c < 0)" using quadratic_shape1b[where a= "-a", where b = "-b", where c = "-c", where x = "x", where y = "y"] using assms(1) assms(2) by force lemma case_d1: fixes a b c r::"real" shows "b < 2 * a * r ⟹ a * r^2 - b*r + c = 0 ⟹ ∃y'>- r. ∀x∈{-r<..y'}. a * x⇧2 + b * x + c < 0" proof - assume b_lt: "b < 2*a*r" assume root: "a*r^2 - b*r + c = 0" then have "c = b*r - a*r^2" by auto have aeq: "a = 0 ⟹ ∃y'>- r. ∀x∈{-r<..y'}. a * x⇧2 + b * x + c < 0" proof - assume azer: "a = 0" then have bltz: "b < 0" using b_lt by auto then have "c = b*r" using azer root by auto then have eval: "∀x. a*x^2 + b*x + c = b*(x + r)" using azer by (simp add: distrib_left) have "∀x > -r. b*(x + r) < 0" proof clarsimp fix x assume xgt: "- r < x" then have "x + r > 0" by linarith then show "b * (x + r) < 0" using bltz using mult_less_0_iff by blast qed then show ?thesis using eval using less_add_same_cancel1 zero_less_one by (metis greaterThanAtMost_iff) qed have aneq: "a ≠ 0 ⟹∃y'>- r. ∀x∈{-r<..y'}. a * x⇧2 + b * x + c < 0" proof - assume aneq: "(a::real) ≠ 0" have "b^2 - 4*a*c < 0 ⟹ a * r⇧2 + b * r + c ≠ 0" using root discriminant_negative[of a b c r] unfolding discrim_def using aneq by auto then have " a * r⇧2 + b * r + c ≠ 0 ⟹ a * r⇧2 - b * r + c = 0 ⟹ b⇧2 < 4 * a * c ⟹ False" proof - assume a1: "a * r⇧2 - b * r + c = 0" assume a2: "b⇧2 < 4 * a * c" have f3: "(0 ≤ - 1 * (4 * a * c) + (- 1 * b)⇧2) = (4 * a * c + - 1 * (- 1 * b)⇧2 ≤ 0)" by simp have f4: "(- 1 * b)⇧2 + - 1 * (4 * a * c) = - 1 * (4 * a * c) + (- 1 * b)⇧2" by auto have f5: "c + a * r⇧2 + - 1 * b * r = a * r⇧2 + c + - 1 * b * r" by auto have f6: "∀x0 x1 x2 x3. (x3::real) * x0⇧2 + x2 * x0 + x1 = x1 + x3 * x0⇧2 + x2 * x0" by simp have f7: "∀x1 x2 x3. (discrim x3 x2 x1 < 0) = (¬ 0 ≤ discrim x3 x2 x1)" by auto have f8: "∀r ra rb. discrim r ra rb = ra⇧2 + - 1 * (4 * r * rb)" using discrim_def by auto have "¬ 4 * a * c + - 1 * (- 1 * b)⇧2 ≤ 0" using a2 by simp then have "a * r⇧2 + c + - 1 * b * r ≠ 0" using f8 f7 f6 f5 f4 f3 by (metis (no_types) aneq discriminant_negative) then show False using a1 by linarith qed then have "¬(b^2 - 4*a*c < 0)" using root using ‹b⇧2 - 4 * a * c < 0 ⟹ a * r⇧2 + b * r + c ≠ 0› by auto then have discrim: "b⇧2 ≥ 4 * a * c " by auto then have req: "r = (b + sqrt(b^2 - 4*a*c))/(2*a) ∨ r = (b - sqrt(b^2 - 4*a*c))/(2*a)" using aneq root discriminant_iff[where a="a", where b ="-b", where c="c", where x="r"] unfolding discrim_def by auto then have "r = (b - sqrt(b^2 - 4*a*c))/(2*a) ⟹ b > 2*a*r" proof - assume req: "r = (b - sqrt(b^2 - 4*a*c))/(2*a)" then have h1: "2*a*r = 2*a*((b - sqrt(b^2 - 4*a*c))/(2*a))" by auto then have h2: "2*a*((b - sqrt(b^2 - 4*a*c))/(2*a)) = b - sqrt(b^2 - 4*a*c)" using aneq by auto have h3: "sqrt(b^2 - 4*a*c) ≥ 0" using discrim by auto then have "b - sqrt(b^2 - 4*a*c) < b" using b_lt h1 h2 by linarith then show ?thesis using req h2 by auto qed then have req: "r = (b + sqrt(b^2 - 4*a*c))/(2*a)" using req b_lt by auto then have discrim2: "b^2 - 4 *a*c > 0" using aneq b_lt by auto then have "∃x y. x ≠ y ∧ a * x⇧2 + b * x + c = 0 ∧ a * y⇧2 + b * y + c = 0" using aneq discriminant_pos_ex[of a b c] unfolding discrim_def by auto then obtain x y where xy_prop: "x < y ∧ a * x⇧2 + b * x + c = 0 ∧ a * y⇧2 + b * y + c = 0" by (meson linorder_neqE_linordered_idom) then have "(x = (-b + sqrt(b^2 - 4*a*c))/(2*a) ∧ y = (-b - sqrt(b^2 - 4*a*c))/(2*a)) ∨ (y = (-b + sqrt(b^2 - 4*a*c))/(2*a) ∧ x = (-b - sqrt(b^2 - 4*a*c))/(2*a))" using aneq discriminant_iff unfolding discrim_def by auto then have xy_prop2: "(x = (-b + sqrt(b^2 - 4*a*c))/(2*a) ∧ y = -r) ∨ (y = (-b + sqrt(b^2 - 4*a*c))/(2*a) ∧ x = -r)" using req by (simp add: ‹x = (- b + sqrt (b⇧2 - 4 * a * c)) / (2 * a) ∧ y = (- b - sqrt (b⇧2 - 4 * a * c)) / (2 * a) ∨ y = (- b + sqrt (b⇧2 - 4 * a * c)) / (2 * a) ∧ x = (- b - sqrt (b⇧2 - 4 * a * c)) / (2 * a)› minus_divide_left) (* When a < 0, -r is the bigger root *) have alt: "a < 0 ⟹ ∀k > -r. a * k^2 + b * k + c < 0" proof clarsimp fix k assume alt: " a < 0" assume "- r < k" have alt2: " (1/(2*a)::real) < 0" using alt by simp have "(-b - sqrt(b^2 - 4*a*c)) < (-b + sqrt(b^2 - 4*a*c))" using discrim2 by auto then have "(-b - sqrt(b^2 - 4*a*c))* (1/(2*a)::real) > (-b + sqrt(b^2 - 4*a*c))* (1/(2*a)::real)" using alt2 using mult_less_cancel_left_neg by fastforce then have rgtroot: "-r > (-b + sqrt(b^2 - 4*a*c))/(2*a)" using req ‹x = (- b + sqrt (b⇧2 - 4 * a * c)) / (2 * a) ∧ y = (- b - sqrt (b⇧2 - 4 * a * c)) / (2 * a) ∨ y = (- b + sqrt (b⇧2 - 4 * a * c)) / (2 * a) ∧ x = (- b - sqrt (b⇧2 - 4 * a * c)) / (2 * a)› xy_prop2 by auto then have "(y = -r ∧ x = (-b + sqrt(b^2 - 4*a*c))/(2*a))" using xy_prop xy_prop2 by auto then show "a * k^2 + b * k + c < 0" using xy_prop ‹- r < k› alt quadratic_shape2b xy_prop by blast qed (* When a > 0, -r is the smaller root *) have agt: "a > 0 ⟹ ∃y'>- r. ∀x∈{-r<..y'}. a * x⇧2 + b * x + c < 0" proof - assume agt: "a> 0" have alt2: " (1/(2*a)::real) > 0" using agt by simp have "(-b - sqrt(b^2 - 4*a*c)) < (-b + sqrt(b^2 - 4*a*c))" using discrim2 by auto then have "(-b - sqrt(b^2 - 4*a*c))* (1/(2*a)::real) < (-b + sqrt(b^2 - 4*a*c))* (1/(2*a)::real)" using alt2 proof - have f1: "- b - sqrt (b⇧2 - c * (4 * a)) < - b + sqrt (b⇧2 - c * (4 * a))" by (metis ‹- b - sqrt (b⇧2 - 4 * a * c) < - b + sqrt (b⇧2 - 4 * a * c)› mult.commute) have "0 < a * 2" using ‹0 < 1 / (2 * a)› by auto then show ?thesis using f1 by (simp add: divide_strict_right_mono mult.commute) qed then have rlltroot: "-r < (-b + sqrt(b^2 - 4*a*c))/(2*a)" using req ‹x = (- b + sqrt (b⇧2 - 4 * a * c)) / (2 * a) ∧ y = (- b - sqrt (b⇧2 - 4 * a * c)) / (2 * a) ∨ y = (- b + sqrt (b⇧2 - 4 * a * c)) / (2 * a) ∧ x = (- b - sqrt (b⇧2 - 4 * a * c)) / (2 * a)› xy_prop2 by auto then have "(x = -r ∧ y = (-b + sqrt(b^2 - 4*a*c))/(2*a))" using xy_prop xy_prop2 by auto have "∃k. x < k ∧ k < y" using xy_prop dense by auto then obtain k where k_prop: "x < k ∧ k < y" by auto then have "∀x∈{-r<..k}. a * x⇧2 + b * x + c < 0" using agt quadratic_shape1a[where a= "a", where b = "b", where c= "c", where x = "x", where y = "y"] using ‹x = - r ∧ y = (- b + sqrt (b⇧2 - 4 * a * c)) / (2 * a)› greaterThanAtMost_iff xy_prop by auto then show "∃y'>- r. ∀x∈{-r<..y'}. a * x⇧2 + b * x + c < 0" using k_prop using ‹x = - r ∧ y = (- b + sqrt (b⇧2 - 4 * a * c)) / (2 * a)› by blast qed show ?thesis using alt agt by (metis aneq greaterThanAtMost_iff less_add_same_cancel1 linorder_neqE_linordered_idom zero_less_one) qed show "∃y'>- r. ∀x∈{-r<..y'}. a * x⇧2 + b * x + c < 0" using aeq aneq by blast qed lemma case_d4: fixes a b c r::"real" shows "⋀y'. b ≠ 2 * a * r ⟹ ¬ b < 2 * a * r ⟹ a *r^2 - b * r + c = 0 ⟹ -r < y' ⟹ ∃x∈{-r<..y'}. ¬ a * x⇧2 + b * x + c < 0" proof - fix y' assume bneq: "b ≠ 2 * a * r" assume bnotless: "¬ b < 2 * a * r" assume root: "a *r^2 - b * r + c = 0" assume y_prop: "-r < y'" have b_gt: "b > 2*a*r" using bneq bnotless by auto have aeq: "a = 0 ⟹ ∃y'>- r. ∀x∈{-r<..y'}. a * x⇧2 + b * x + c > 0" proof - assume azer: "a = 0" then have bgt: "b > 0" using b_gt by auto then have "c = b*r" using azer root by auto then have eval: "∀x. a*x^2 + b*x + c = b*(x + r)" using azer by (simp add: distrib_left) have "∀x > -r. b*(x + r) > 0" proof clarsimp fix x assume xgt: "- r < x" then have "x + r > 0" by linarith then show "b * (x + r) > 0" using bgt by auto qed then show ?thesis using eval using less_add_same_cancel1 zero_less_one by (metis greaterThanAtMost_iff) qed have aneq: "a ≠ 0 ⟹∃y'>- r. ∀x∈{-r<..y'}. a * x⇧2 + b * x + c > 0" proof - assume aneq: "a≠0" { assume a1: "a * r⇧2 - b * r + c = 0" assume a2: "b⇧2 < 4 * a * c" have f3: "(0 ≤ - 1 * (4 * a * c) + (- 1 * b)⇧2) = (4 * a * c + - 1 * (- 1 * b)⇧2 ≤ 0)" by simp have f4: "(- 1 * b)⇧2 + - 1 * (4 * a * c) = - 1 * (4 * a * c) + (- 1 * b)⇧2" by auto have f5: "c + a * r⇧2 + - 1 * b * r = a * r⇧2 + c + - 1 * b * r" by auto have f6: "∀x0 x1 x2 x3. (x3::real) * x0⇧2 + x2 * x0 + x1 = x1 + x3 * x0⇧2 + x2 * x0" by simp have f7: "∀x1 x2 x3. (discrim x3 x2 x1 < 0) = (¬ 0 ≤ discrim x3 x2 x1)" by auto have f8: "∀r ra rb. discrim r ra rb = ra⇧2 + - 1 * (4 * r * rb)" using discrim_def by auto have "¬ 4 * a * c + - 1 * (- 1 * b)⇧2 ≤ 0" using a2 by simp then have "a * r⇧2 + c + - 1 * b * r ≠ 0" using f8 f7 f6 f5 f4 f3 by (metis (no_types) aneq discriminant_negative) then have False using a1 by linarith } note * = this have "b^2 - 4*a*c < 0 ⟹ a * r⇧2 + b * r + c ≠ 0" using root discriminant_negative[of a b c r] unfolding discrim_def using aneq by auto then have "¬(b^2 - 4*a*c < 0)" using root * by auto then have discrim: "b⇧2 ≥ 4 * a * c " by auto then have req: "r = (b + sqrt(b^2 - 4*a*c))/(2*a) ∨ r = (b - sqrt(b^2 - 4*a*c))/(2*a)" using aneq root discriminant_iff[where a="a", where b ="-b", where c="c", where x="r"] unfolding discrim_def by auto then have "r = (b + sqrt(b^2 - 4*a*c))/(2*a) ⟹ b < 2*a*r" proof - assume req: "r = (b + sqrt(b^2 - 4*a*c))/(2*a)" then have h1: "2*a*r = 2*a*((b + sqrt(b^2 - 4*a*c))/(2*a))" by auto then have h2: "2*a*((b + sqrt(b^2 - 4*a*c))/(2*a)) = b + sqrt(b^2 - 4*a*c)" using aneq by auto have h3: "sqrt(b^2 - 4*a*c) ≥ 0" using discrim by auto then have "b + sqrt(b^2 - 4*a*c) > b" using b_gt h1 h2 by linarith then show ?thesis using req h2 by auto qed then have req: "r = (b - sqrt(b^2 - 4*a*c))/(2*a)" using req b_gt using aneq discrim by auto then have discrim2: "b^2 - 4 *a*c > 0" using aneq b_gt by auto then have "∃x y. x ≠ y ∧ a * x⇧2 + b * x + c = 0 ∧ a * y⇧2 + b * y + c = 0" using aneq discriminant_pos_ex[of a b c] unfolding discrim_def by auto then obtain x y where xy_prop: "x < y ∧ a * x⇧2 + b * x + c = 0 ∧ a * y⇧2 + b * y + c = 0" by (meson linorder_neqE_linordered_idom) then have "(x = (-b + sqrt(b^2 - 4*a*c))/(2*a) ∧ y = (-b - sqrt(b^2 - 4*a*c))/(2*a)) ∨ (y = (-b + sqrt(b^2 - 4*a*c))/(2*a) ∧ x = (-b - sqrt(b^2 - 4*a*c))/(2*a))" using aneq discriminant_iff unfolding discrim_def by auto then have xy_prop2: "(x = (-b - sqrt(b^2 - 4*a*c))/(2*a) ∧ y = -r) ∨ (y = (-b - sqrt(b^2 - 4*a*c))/(2*a) ∧ x = -r)" using req divide_inverse minus_diff_eq mult.commute mult_minus_right by (smt (verit, ccfv_SIG) uminus_add_conv_diff) (* When a > 0, -r is the greater root *) have agt: "a > 0 ⟹ ∀k > -r. a * k^2 + b * k + c > 0" proof clarsimp fix k assume agt: " a > 0" assume "- r < k" have agt2: " (1/(2*a)::real) > 0" using agt by simp have "(-b - sqrt(b^2 - 4*a*c)) < (-b + sqrt(b^2 - 4*a*c))" using discrim2 by auto then have "(-b - sqrt(b^2 - 4*a*c))* (1/(2*a)::real) < (-b + sqrt(b^2 - 4*a*c))* (1/(2*a)::real)" using agt2 by (simp add: divide_strict_right_mono) then have rgtroot: "-r > (-b - sqrt(b^2 - 4*a*c))/(2*a)" using req ‹x = (- b + sqrt (b⇧2 - 4 * a * c)) / (2 * a) ∧ y = (- b - sqrt (b⇧2 - 4 * a * c)) / (2 * a) ∨ y = (- b + sqrt (b⇧2 - 4 * a * c)) / (2 * a) ∧ x = (- b - sqrt (b⇧2 - 4 * a * c)) / (2 * a)› xy_prop2 by auto then have "(x = (-b - sqrt(b^2 - 4*a*c))/(2*a)) ∧ y = -r" using xy_prop xy_prop2 by auto then show "a * k^2 + b * k + c > 0" using ‹- r < k› xy_prop agt quadratic_shape1b[where a= "a", where b ="b", where c="c", where x = "x", where y = "-r", where z = "k"] by blast qed (* When a < 0, -r is the smaller root *) have agt2: "a < 0 ⟹ ∃y'>- r. ∀x∈{-r<..y'}. a * x⇧2 + b * x + c > 0" proof - assume alt: "a<0" have alt2: " (1/(2*a)::real) < 0" using alt by simp have "(-b - sqrt(b^2 - 4*a*c)) < (-b + sqrt(b^2 - 4*a*c))" using discrim2 by auto then have "(-b - sqrt(b^2 - 4*a*c))* (1/(2*a)::real) > (-b + sqrt(b^2 - 4*a*c))* (1/(2*a)::real)" using alt2 using mult_less_cancel_left_neg by fastforce then have rlltroot: "-r < (-b - sqrt(b^2 - 4*a*c))/(2*a)" using req using ‹x = (- b + sqrt (b⇧2 - 4 * a * c)) / (2 * a) ∧ y = (- b - sqrt (b⇧2 - 4 * a * c)) / (2 * a) ∨ y = (- b + sqrt (b⇧2 - 4 * a * c)) / (2 * a) ∧ x = (- b - sqrt (b⇧2 - 4 * a * c)) / (2 * a)› xy_prop2 by auto then have h: "(x = -r ∧ y = (-b - sqrt(b^2 - 4*a*c))/(2*a))" using xy_prop xy_prop2 by auto have "∃k. x < k ∧ k < y" using xy_prop dense by auto then obtain k where k_prop: "x < k ∧ k < y" by auto then have "∀x∈{-r<..k}. a * x⇧2 + b * x + c > 0" using alt quadratic_shape2a[where a= "a", where b = "b", where c= "c", where x = "x", where y = "y"] xy_prop h greaterThanAtMost_iff by auto then show "∃y'>- r. ∀x∈{-r<..y'}. a * x⇧2 + b * x + c > 0" using k_prop using h by blast qed show ?thesis using aneq agt agt2 by (meson greaterThanAtMost_iff linorder_neqE_linordered_idom y_prop) qed show "∃x∈{-r<..y'}. ¬ a * x⇧2 + b * x + c < 0" using aneq aeq by (metis greaterThanAtMost_iff less_eq_real_def linorder_not_less y_prop) qed lemma one_root_a_lt0: fixes a b c r y'::"real" assumes alt: "a < 0" assumes beq: "b = 2 * a * r" assumes root: " a * r^2 - 2*a*r*r + c = 0" shows "∃y'>- r. ∀x∈{- r<..y'}. a * x⇧2 + 2*a*r*x + c < 0" proof - have root_iff: "∀x. a * x⇧2 + b * x + c = 0 ⟷ x = -r" using alt root discriminant_lemma[where r = "r"] beq by auto have "a < 0 ⟶ (∃y. ∀x > y. a*x^2 + b*x + c < 0)" using neg_lc_dom_quad by auto then obtain k where k_prop: "∀x > k. a*x^2 + b*x + c < 0" using alt by auto let ?mx = "max (k+1) (-r + 1)" have "a*?mx^2 + b*?mx + c < 0" using k_prop by auto then have "∃y > -r. a*y^2 + b*y + c < 0" by force then obtain z where z_prop: "z > -r ∧ a*z^2 + b*z + c < 0" by auto have poly_eval_prop: "∀(x::real). poly [:c, b, a :] x = a*x^2 + b*x + c" using quadratic_poly_eval by auto then have nozer: "¬(∃x. (x > -r ∧ poly [:c, b, a :] x = 0))" using root_iff by (simp add: add.commute) have poly_z: "poly [:c, b, a:] z < 0" using z_prop poly_eval_prop by auto have "∀y > -r. a*y^2 + b*y + c < 0" proof clarsimp fix y assume ygt: "- r < y" have h1: "y = z ⟹ a * y⇧2 + b * y + c < 0" using z_prop by auto have h2: "y < z ⟹ a * y⇧2 + b * y + c < 0" proof - assume ylt: "y < z" have notz: "a*y^2 + b*y + c ≠ 0" using ygt nozer poly_eval_prop by auto have h1: "a *y^2 + b*y + c > 0 ⟹ poly [:c, b, a:] y > 0" using poly_eval_prop by auto have ivtprop: "poly [:c, b, a:] y > 0 ⟹ (∃x. y < x ∧ x < z ∧ poly [:c, b, a:] x = 0)" using ylt poly_z poly_IVT_neg[where a = "y", where b = "z", where p = "[:c, b, a:]"] by auto then have "a*y^2 + b*y + c > 0 ⟹ False" using h1 ivtprop ygt nozer by auto then show "a*y^2 + b*y + c < 0" using notz using linorder_neqE_linordered_idom by blast qed have h3: "y > z ⟹ a * y⇧2 + b * y + c < 0" proof - assume ygtz: "y > z" have notz: "a*y^2 + b*y + c ≠ 0" using ygt nozer poly_eval_prop by auto have h1: "a *y^2 + b*y + c > 0 ⟹ poly [:c, b, a:] y > 0" using poly_eval_prop by auto have ivtprop: "poly [:c, b, a:] y > 0 ⟹ (∃x. z < x ∧ x < y ∧ poly [:c, b, a:] x = 0)" using ygtz poly_z using poly_IVT_pos by blast then have "a*y^2 + b*y + c > 0 ⟹ False" using h1 ivtprop z_prop nozer by auto then show "a*y^2 + b*y + c < 0" using notz using linorder_neqE_linordered_idom by blast qed show "a * y⇧2 + b * y + c < 0" using h1 h2 h3 using linorder_neqE_linordered_idom by blast qed then show ?thesis using ‹∃y>- r. a * y⇧2 + b * y + c < 0› beq by auto qed lemma one_root_a_lt0_var: fixes a b c r y'::"real" assumes alt: "a < 0" assumes beq: "b = 2 * a * r" assumes root: " a * r^2 - 2*a*r*r + c = 0" shows "∃y'>- r. ∀x∈{- r<..y'}. a * x⇧2 + 2*a*r*x + c ≤ 0" proof - have h1: "∃y'>- r. ∀x∈{- r<..y'}. a * x⇧2 + 2 * a * r * x + c < 0 ⟹ ∃y'>-r. ∀x∈{- r<..y'}. a * x⇧2 + 2 * a *r * x + c ≤ 0" using less_eq_real_def by blast then show ?thesis using one_root_a_lt0[of a b r] assms by auto qed subsection "More Continuity Properties" lemma continuity_lem_gt0_expanded_var: fixes r:: "real" fixes a b c:: "real" fixes k::"real" assumes kgt: "k > r" shows "a*r^2 + b*r + c > 0 ⟹ ∃x∈{r<..k}. a*x^2 + b*x + c ≥ 0" proof - assume a: "a*r^2 + b*r + c > 0 " have h: "∃x∈{r<..k}. a*x^2 + b*x + c > 0 ⟹ ∃x∈{r<..k}. a*x^2 + b*x + c ≥ 0" using less_eq_real_def by blast have "∃x∈{r<..k}. a*x^2 + b*x + c > 0" using a continuity_lem_gt0_expanded[of r k a b c] assms by auto then show "∃x∈{r<..k}. a*x^2 + b*x + c ≥ 0" using h by auto qed lemma continuity_lem_lt0_expanded_var: fixes r:: "real" fixes a b c:: "real" shows "a*r^2 + b*r + c < 0 ⟹ ∃y'> r. ∀x∈{r<..y'}. a*x^2 + b*x + c ≤ 0" proof - assume "a*r^2 + b*r + c < 0 " then have " ∃y'> r. ∀x∈{r<..y'}. a*x^2 + b*x + c < 0" using continuity_lem_lt0_expanded by auto then show " ∃y'> r. ∀x∈{r<..y'}. a*x^2 + b*x + c ≤ 0" using less_eq_real_def by auto qed lemma nonzcoeffs: fixes a b c r::"real" shows "a≠0 ∨ b≠0 ∨ c≠0 ⟹ ∃y'>r. ∀x∈{r<..y'}. a * x⇧2 + b * x + c ≠ 0 " proof - assume "a≠0 ∨ b≠0 ∨ c≠0" then have fin: "finite {x. a*x^2 + b*x + c = 0}" by (metis pCons_eq_0_iff poly_roots_finite poly_roots_set_same) (* then have fin2: "finite {x. a*x^2 + b*x + c = 0 ∧ x > r}" using finite_Collect_conjI by blast *) let ?s = "{x. a*x^2 + b*x + c = 0}" have imp: "(∃q ∈ ?s. q > r) ⟹ (∃q ∈ ?s. (q > r ∧ (∀x ∈ ?s. x > r ⟶ x ≥ q)))" proof - assume asm: "(∃q ∈ ?s. q > r)" then have none: "{q. q ∈ ?s ∧ q > r} ≠ {}" by blast have fin2: "finite {q. q ∈ ?s ∧ q > r}" using fin by simp have "∃k. k = Min {q. q ∈ ?s ∧ q > r}" using fin2 none by blast then obtain k where k_prop: "k = Min {q. q ∈ ?s ∧ q > r}" by auto then have kp1: "k ∈ ?s ∧ k > r" using Min_in fin2 none by blast then have kp2: "∀x ∈ ?s. x > r ⟶ x ≥ k" using Min_le fin2 using k_prop by blast show "(∃q ∈ ?s. (q > r ∧ (∀x ∈ ?s. x > r ⟶ x ≥ q)))" using kp1 kp2 by blast qed have h2: "(∃q ∈ ?s. q > r) ⟹ ∃y'>r. ∀x∈{r<..y'}. a * x⇧2 + b * x + c ≠ 0" proof - assume "(∃q ∈ ?s. q > r)" then obtain q where q_prop: "q ∈ ?s ∧ (q > r ∧ (∀x ∈ ?s. x > r ⟶ x ≥ q))" using imp by blast then have "∃w. w > r ∧ w < q" using dense by blast then obtain w where w_prop: "w > r ∧ w < q" by auto then have "¬(∃x∈{r<..w}. x ∈ ?s)" using w_prop q_prop by auto then have "∀x∈{r<..w}. a * x⇧2 + b * x + c ≠ 0" by blast then show "∃y'>r. ∀x∈{r<..y'}. a * x⇧2 + b * x + c ≠ 0" using w_prop by blast qed have h1: "¬(∃q ∈ ?s. q > r) ⟹ ∃y'>r. ∀x∈{r<..y'}. a * x⇧2 + b * x + c ≠ 0" proof - assume "¬(∃q ∈ ?s. q > r)" then have "∀x∈{r<..(r+1)}. a * x⇧2 + b * x + c ≠ 0" using greaterThanAtMost_iff by blast then show ?thesis using less_add_same_cancel1 less_numeral_extra(1) by blast qed then show "∃y'>r. ∀x∈{r<..y'}. a * x⇧2 + b * x + c ≠ 0" using h2 by blast qed (* Show if there are infinitely many values of x where a*x^2 + b*x + c is 0, then the a*x^2 + b*x + c is the zero polynomial *) lemma infzeros : fixes y:: "real" assumes "∀x::real < (y::real). a * x⇧2 + b * x + c = 0" shows "a = 0 ∧ b=0 ∧ c=0" proof - let ?A = "{(x::real). x < y}" have "∃ (n::nat) f. ?A = f ` {i. i < n} ∧ inj_on f {i. i < n} ⟹ False" proof clarsimp fix n:: "nat" fix f assume xlt: "{x. x < y} = f ` {i. i < n}" assume injh: "inj_on f {i. i < n}" have "?A ≠ {}" by (simp add: linordered_field_no_lb) then have ngtz: "n > 0" using xlt injh using gr_implies_not_zero by auto have cardisn: "card ?A = n" using xlt injh by (simp add: card_image) have "∀k::nat. ((y - (k::nat) - 1) ∈ ?A)" by auto then have subs: "{k. ∃(x::nat). k = y - x - 1 ∧ 0 ≤ x ∧ x ≤ n} ⊆ ?A" by auto have seteq: "(λx. y - real x - 1) ` {0..n} ={k. ∃(x::nat). k = y - x - 1 ∧ 0 ≤ x ∧ x ≤ n}" by auto have injf: "inj_on (λx. y - real x - 1) {0..n}" unfolding inj_on_def by auto have "card {k. ∃(x::nat). k = y - x - 1 ∧ 0 ≤ x ∧ x ≤ n} = n + 1" using injf seteq card_atMost inj_on_iff_eq_card[where A = "{0..n}", where f = "λx. y - x - 1"] by auto then have if_fin: "finite ?A ⟹ card ?A ≥ n + 1" using subs card_mono by (metis (lifting) card_mono) then have if_inf: "infinite ?A ⟹ card ?A = 0" by (meson card.infinite) then show "False" using if_fin if_inf cardisn ngtz by auto qed then have nfin: "¬ finite {(x::real). x < y}" using finite_imp_nat_seg_image_inj_on by blast have "{(x::real). x < y} ⊆ {x. a*x^2 + b*x + c = 0}" using assms by auto then have nfin2: "¬ finite {x. a*x^2 + b*x + c = 0}" using nfin finite_subset by blast { fix x assume "a * x⇧2 + b * x + c = 0" then have f1: "a * (x * x) + x * b + c = 0" by (simp add: Groups.mult_ac(2) power2_eq_square) have f2: "∀r. c + (r + (c + - c)) = r + c" by simp have f3: "∀r ra rb. (rb::real) * ra + ra * r = (rb + r) * ra" by (metis Groups.mult_ac(2) Rings.ring_distribs(2)) have "∀r. r + (c + - c) = r" by simp then have "c + x * (b + x * a) = 0" using f3 f2 f1 by (metis Groups.add_ac(3) Groups.mult_ac(1) Groups.mult_ac(2)) } hence "{x. a*x^2 + b*x + c = 0} ⊆ {x. poly [:c, b, a:] x = 0}" by auto then have " ¬ finite {x. poly [:c, b, a:] x = 0}" using nfin2 using finite_subset by blast then have "[:c, b, a:] = 0" using poly_roots_finite[where p = "[:c, b, a:]"] by auto then show ?thesis by auto qed lemma have_inbetween_point_leq: fixes r::"real" assumes "(∀((d::real), (e::real), (f::real))∈set leq. ∃y'>r. ∀x∈{r<..y'}. d * x⇧2 + e * x + f ≤ 0)" shows "(∃x. (∀(a, b, c)∈set leq. a * x⇧2 + b * x + c ≤ 0))" proof - have "(∀(d, e, f)∈set leq. ∃y'>r. ∀x∈{r<..y'}. d * x⇧2 + e * x + f ≤ 0) ⟹ (∃y'>r. (∀(d, e, f)∈set leq. ∀x∈{r<..y'}. d * x⇧2 + e * x + f ≤ 0))" using leq_qe_inf_helper assms by auto then have "(∃y'>r. (∀(d, e, f)∈set leq. ∀x∈{r<..y'}. d * x⇧2 + e * x + f ≤ 0))" using assms by blast then obtain y where y_prop: "y > r ∧ (∀(d, e, f)∈set leq. ∀x∈{r<..y}. d * x⇧2 + e * x + f ≤ 0)" by auto have "∃q. q > r ∧q < y" using y_prop dense by auto then obtain q where q_prop: "q > r ∧ q < y" by auto then have "(∀(d, e, f)∈set leq. d*q^2 + e*q + f ≤ 0)" using y_prop by auto then show ?thesis by auto qed lemma have_inbetween_point_neq: fixes r::"real" assumes "(∀((d::real), (e::real), (f::real))∈set neq. ∃y'>r. ∀x∈{r<..y'}. d * x⇧2 + e * x + f ≠ 0)" shows "(∃x. (∀(a, b, c)∈set neq. a * x⇧2 + b * x + c ≠ 0))" proof - have "(∀(d, e, f)∈set neq. ∃y'>r. ∀x∈{r<..y'}. d * x⇧2 + e * x + f ≠ 0) ⟹ (∃y'>r. (∀(d, e, f)∈set neq. ∀x∈{r<..y'}. d * x⇧2 + e * x + f ≠ 0))" using neq_qe_inf_helper assms by auto then have "(∃y'>r. (∀(d, e, f)∈set neq. ∀x∈{r<..y'}. d * x⇧2 + e * x + f ≠ 0))" using assms by blast then obtain y where y_prop: "y > r ∧ (∀(d, e, f)∈set neq. ∀x∈{r<..y}. d * x⇧2 + e * x + f ≠ 0)" by auto have "∃q. q > r ∧q < y" using y_prop dense by auto then obtain q where q_prop: "q > r ∧ q < y" by auto then have "(∀(d, e, f)∈set neq. d*q^2 + e*q + f ≠ 0)" using y_prop by auto then show ?thesis by auto qed subsection "Setting up and Helper Lemmas" subsubsection "The les\\_qe lemma" lemma les_qe_forward : shows "(((∀(a, b, c)∈set les. ∃x. ∀y<x. a * y⇧2 + b * y + c < 0) ∨ (∃(a', b', c')∈set les. a' = 0 ∧ b' ≠ 0 ∧ (∀(d, e, f)∈set les. ∃y'>- (c' / b'). ∀x∈{- (c' / b')<..y'}. d * x⇧2 + e * x + f < 0) ∨ a' ≠ 0 ∧ 4 * a' * c' ≤ b'⇧2 ∧ ((∀(d, e, f)∈set les. ∃y'>(sqrt (b'⇧2 - 4 * a' * c') - b') / (2 * a'). ∀x∈{(sqrt (b'⇧2 - 4 * a' * c') - b') / (2 * a')<..y'}. d * x⇧2 + e * x + f < 0) ∨ (∀(d, e, f)∈set les. ∃y'>(- b' - sqrt (b'⇧2 - 4 * a' * c')) / (2 * a'). ∀x∈{(- b' - sqrt (b'⇧2 - 4 * a' * c')) / (2 * a')<..y'}. d * x⇧2 + e * x + f < 0))))) ⟹ ((∃x. (∀(a, b, c)∈set les. a * x⇧2 + b * x + c < 0)))" proof - assume big_asm: "(((∀(a, b, c)∈set les. ∃x. ∀y<x. a * y⇧2 + b * y + c < 0) ∨ (∃(a', b', c')∈set les. a' = 0 ∧ b' ≠ 0 ∧ (∀(d, e, f)∈set les. ∃y'>- (c' / b'). ∀x∈{- (c' / b')<..y'}. d * x⇧2 + e * x + f < 0) ∨ a' ≠ 0 ∧ 4 * a' * c' ≤ b'⇧2 ∧ ((∀(d, e, f)∈set les. ∃y'>(sqrt (b'⇧2 - 4 * a' * c') - b') / (2 * a'). ∀x∈{(sqrt (b'⇧2 - 4 * a' * c') - b') / (2 * a')<..y'}. d * x⇧2 + e * x + f < 0) ∨ (∀(d, e, f)∈set les. ∃y'>(- b' - sqrt (b'⇧2 - 4 * a' * c')) / (2 * a'). ∀x∈{(- b' - sqrt (b'⇧2 - 4 * a' * c')) / (2 * a')<..y'}. d * x⇧2 + e * x + f < 0)))))" then have big_or: "(∀(a, b, c)∈set les. ∃x. ∀y<x. a * y⇧2 + b * y + c < 0) ∨ (∃(a', b', c')∈set les. a' = 0 ∧ b' ≠ 0 ∧ (∀(d, e, f)∈set les. ∃y'>- (c' / b'). ∀x∈{- (c' / b')<..y'}. d * x⇧2 + e * x + f < 0)) ∨ (∃(a', b', c')∈set les. a' ≠ 0 ∧ 4 * a' * c' ≤ b'⇧2 ∧ (∀(d, e, f)∈set les. ∃y'>(sqrt (b'⇧2 - 4 * a' * c') - b') / (2 * a'). ∀x∈{(sqrt (b'⇧2 - 4 * a' * c') - b') / (2 * a')<..y'}. d * x⇧2 + e * x + f < 0)) ∨ (∃(a', b', c')∈set les. a' ≠ 0 ∧ 4 * a' * c' ≤ b'⇧2 ∧ (∀(d, e, f)∈set les. ∃y'>(- b' - sqrt (b'⇧2 - 4 * a' * c')) / (2 * a'). ∀x∈{(- b' - sqrt (b'⇧2 - 4 * a' * c')) / (2 * a')<..y'}. d * x⇧2 + e * x + f < 0)) " by auto have h1_helper: "(∀(a, b, c)∈set les. ∃x. ∀y<x. a * y⇧2 + b * y + c < 0) ⟹ (∃y.∀x<y. (∀(a, b, c)∈set les. a * x⇧2 + b * x + c < 0))" proof - show "(∀(a, b, c)∈set les. ∃x. ∀y<x. a * y⇧2 + b * y + c < 0) ⟹ (∃y.∀x<y. (∀(a, b, c)∈set les. a * x⇧2 + b * x + c < 0))" proof (induct les) case Nil then show ?case by auto next case (Cons q les) have ind: " ∀a∈set (q # les). case a of (a, ba, c) ⇒ ∃x. ∀y<x. a * y⇧2 + ba * y + c < 0" using Cons.prems by auto then have "case q of (a, ba, c) ⇒ ∃x. ∀y<x. a * y⇧2 + ba * y + c < 0 " by simp then obtain y2 where y2_prop: "case q of (a, ba, c) ⇒ (∀y<y2. a * y⇧2 + ba * y + c < 0)" by auto have "∀a∈set les. case a of (a, ba, c) ⇒ ∃x. ∀y<x. a * y⇧2 + ba * y + c < 0" using ind by simp then have " ∃y. ∀x<y. ∀a∈set les. case a of (a, ba, c) ⇒ a * x⇧2 + ba * x + c < 0" using Cons.hyps by blast then obtain y1 where y1_prop: "∀x<y1. ∀a∈set les. case a of (a, ba, c) ⇒ a * x^2 + ba * x + c < 0" by blast let ?y = "min y1 y2" have "∀x < ?y. (∀a∈set (q #les). case a of (a, ba, c) ⇒ a * x^2 + ba * x + c < 0)" using y1_prop y2_prop by fastforce then show ?case by blast qed qed then have h1: "(∀(a, b, c)∈set les. ∃x. ∀y<x. a * y⇧2 + b * y + c < 0) ⟹(∃x. (∀(a, b, c)∈set les. a * x⇧2 + b * x + c < 0))" by (smt (z3) infzeros less_eq_real_def not_numeral_le_zero) (* apply (auto) by (metis (lifting) infzeros zero_neq_numeral) *) have h2: " (∃(a', b', c')∈set les. a' = 0 ∧ b' ≠ 0 ∧ (∀(d, e, f)∈set les. ∃y'>- (c' / b'). ∀x∈{- (c' / b')<..y'}. d * x⇧2 + e * x + f < 0)) ⟹ (∃x. (∀(a, b, c)∈set les. a * x⇧2 + b * x + c < 0))" proof - assume asm: "(∃(a', b', c')∈set les. a' = 0 ∧ b' ≠ 0 ∧ (∀(d, e, f)∈set les. ∃y'>- (c' / b'). ∀x∈{- (c' / b')<..y'}. d * x⇧2 + e * x + f < 0))" then obtain a' b' c' where abc_prop: "(a', b', c') ∈set les ∧ a' = 0 ∧ b' ≠ 0 ∧ (∀(d, e, f)∈set les. ∃y'>- (c' / b'). ∀x∈{- (c' / b')<..y'}. d * x⇧2 + e * x + f < 0)" by auto then show "(∃x. (∀(a, b, c)∈set les. a * x⇧2 + b * x + c < 0))" using have_inbetween_point_les by auto qed have h3: " (∃(a', b', c')∈set les. a' ≠ 0 ∧ 4 * a' * c' ≤ b'⇧2 ∧ (∀(d, e, f)∈set les. ∃y'>(sqrt (b'⇧2 - 4 * a' * c') - b') / (2 * a'). ∀x∈{(sqrt (b'⇧2 - 4 * a' * c') - b') / (2 * a')<..y'}. d * x⇧2 + e * x + f < 0)) ⟹ ((∃x. (∀(a, b, c)∈set les. a * x⇧2 + b * x + c < 0)))" proof - assume asm: "∃(a', b', c')∈set les. a' ≠ 0 ∧ 4 * a' * c' ≤ b'⇧2 ∧ (∀(d, e, f)∈set les. ∃y'>(sqrt (b'⇧2 - 4 * a' * c') - b') / (2 * a'). ∀x∈{(sqrt (b'⇧2 - 4 * a' * c') - b') / (2 * a')<..y'}. d * x⇧2 + e * x + f < 0)" then obtain a' b' c' where abc_prop: "(a', b', c')∈set les ∧ a' ≠ 0 ∧ 4 * a' * c' ≤ b'⇧2 ∧ (∀(d, e, f)∈set les. ∃y'>(sqrt (b'⇧2 - 4 * a' * c') - b') / (2 * a'). ∀x∈{(sqrt (b'⇧2 - 4 * a' * c') - b') / (2 * a')<..y'}. d * x⇧2 + e * x + f < 0)" by auto then show "(∃x. (∀(a, b, c)∈set les. a * x⇧2 + b * x + c < 0))" using have_inbetween_point_les by auto qed have h4: "(∃(a', b', c')∈set les. a' ≠ 0 ∧ 4 * a' * c' ≤ b'⇧2 ∧ (∀(d, e, f)∈set les. ∃y'>(- b' - sqrt (b'⇧2 - 4 * a' * c')) / (2 * a'). ∀x∈{(- b' - sqrt (b'⇧2 - 4 * a' * c')) / (2 * a')<..y'}. d * x⇧2 + e * x + f < 0)) ⟹ (∃x. (∀(a, b, c)∈set les. a * x⇧2 + b * x + c < 0))" proof - assume asm: "(∃(a', b', c')∈set les. a' ≠ 0 ∧ 4 * a' * c' ≤ b'⇧2 ∧ (∀(d, e, f)∈set les. ∃y'>(- b' - sqrt (b'⇧2 - 4 * a' * c')) / (2 * a'). ∀x∈{(- b' - sqrt (b'⇧2 - 4 * a' * c')) / (2 * a')<..y'}. d * x⇧2 + e * x + f < 0)) " then obtain a' b' c' where abc_prop: "(a', b', c')∈set les ∧ a' ≠ 0 ∧ 4 * a' * c' ≤ b'⇧2 ∧ (∀(d, e, f)∈set les. ∃y'>(- b' - sqrt (b'⇧2 - 4 * a' * c')) / (2 * a'). ∀x∈{(- b' - sqrt (b'⇧2 - 4 * a' * c')) / (2 * a')<..y'}. d * x⇧2 + e * x + f < 0)" by auto then have "(∃x. (∀(a, b, c)∈set les. a * x⇧2 + b * x + c < 0))" using have_inbetween_point_les by auto then show ?thesis using asm by auto qed show ?thesis using big_or h1 h2 h3 h4 by blast qed (*sample points, some starter proofs below in comments *) lemma les_qe_backward : shows "(∃x. (∀(a, b, c)∈set les. a * x⇧2 + b * x + c < 0)) ⟹ ((∀(a, b, c)∈set les. ∃x. ∀y<x. a * y⇧2 + b * y + c < 0) ∨ (∃(a', b', c')∈set les. a' = 0 ∧ b' ≠ 0 ∧ (∀(d, e, f)∈set les. ∃y'>- (c' / b'). ∀x∈{- (c' / b')<..y'}. d * x⇧2 + e * x + f < 0) ∨ a' ≠ 0 ∧ 4 * a' * c' ≤ b'⇧2 ∧ ((∀(d, e, f)∈set les. ∃y'>(sqrt (b'⇧2 - 4 * a' * c') - b') / (2 * a'). ∀x∈{(sqrt (b'⇧2 - 4 * a' * c') - b') / (2 * a')<..y'}. d * x⇧2 + e * x + f < 0) ∨ (∀(d, e, f)∈set les. ∃y'>(- b' - sqrt (b'⇧2 - 4 * a' * c')) / (2 * a'). ∀x∈{(- b' - sqrt (b'⇧2 - 4 * a' * c')) / (2 * a')<..y'}. d * x⇧2 + e * x + f < 0))))" proof - assume havex: "(∃x. (∀(a, b, c)∈set les. a * x⇧2 + b * x + c < 0))" then obtain x where x_prop: "∀(a, b, c)∈set les. a * x⇧2 + b * x + c < 0" by auto have h: "(¬ (∀(a, b, c)∈set les. ∃x. ∀y<x. a * y⇧2 + b * y + c < 0) ∧ ¬ (∃(a', b', c')∈set les. a' = 0 ∧ b' ≠ 0 ∧ (∀(d, e, f)∈set les. ∃y'>- (c' / b'). ∀x∈{- (c' / b')<..y'}. d * x⇧2 + e * x + f < 0)) ∧ ¬ (∃(a', b', c')∈set les. a' ≠ 0 ∧ 4 * a' * c' ≤ b'⇧2 ∧ (∀(d, e, f)∈set les. ∃y'>(sqrt (b'⇧2 - 4 * a' * c') - b') / (2 * a'). ∀x∈{(sqrt (b'⇧2 - 4 * a' * c') - b') / (2 * a')<..y'}. d * x⇧2 + e * x + f < 0)) ∧ ¬ (∃(a', b', c')∈set les. a' ≠ 0 ∧ 4 * a' * c' ≤ b'⇧2 ∧ (∀(d, e, f)∈set les. ∃y'>(- b' - sqrt (b'⇧2 - 4 * a' * c')) / (2 * a'). ∀x∈{(- b' - sqrt (b'⇧2 - 4 * a' * c')) / (2 * a')<..y'}. d * x⇧2 + e * x + f < 0))) ⟹ False" proof - assume big: "(¬ (∀(a, b, c)∈set les. ∃x. ∀y<x. a * y⇧2 + b * y + c < 0) ∧ ¬ (∃(a', b', c')∈set les. a' = 0 ∧ b' ≠ 0 ∧ (∀(d, e, f)∈set les. ∃y'>- (c' / b'). ∀x∈{- (c' / b')<..y'}. d * x⇧2 + e * x + f < 0)) ∧ ¬ (∃(a', b', c')∈set les. a' ≠ 0 ∧ 4 * a' * c' ≤ b'⇧2 ∧ (∀(d, e, f)∈set les. ∃y'>(sqrt (b'⇧2 - 4 * a' * c') - b') / (2 * a'). ∀x∈{(sqrt (b'⇧2 - 4 * a' * c') - b') / (2 * a')<..y'}. d * x⇧2 + e * x + f < 0)) ∧ ¬ (∃(a', b', c')∈set les. a' ≠ 0 ∧ 4 * a' * c' ≤ b'⇧2 ∧ (∀(d, e, f)∈set les. ∃y'>(- b' - sqrt (b'⇧2 - 4 * a' * c')) / (2 * a'). ∀x∈{(- b' - sqrt (b'⇧2 - 4 * a' * c')) / (2 * a')<..y'}. d * x⇧2 + e * x + f < 0)))" have notneginf: "¬ (∀(a, b, c)∈set les. ∃x. ∀y<x. a * y⇧2 + b * y + c < 0)" using big by auto have notlinroot: "¬ (∃(a', b', c')∈set les. a' = 0 ∧ b' ≠ 0 ∧ (∀(d, e, f)∈set les. ∃y'>- (c' / b'). ∀x∈{- (c' / b')<..y'}. d * x⇧2 + e * x + f < 0))" using big by auto have notquadroot1: " ¬ (∃(a', b', c')∈set les. a' ≠ 0 ∧ 4 * a' * c' ≤ b'⇧2 ∧ (∀(d, e, f)∈set les. ∃y'>(sqrt (b'⇧2 - 4 * a' * c') - b') / (2 * a'). ∀x∈{(sqrt (b'⇧2 - 4 * a' * c') - b') / (2 * a')<..y'}. d * x⇧2 + e * x + f < 0))" using big by auto have notquadroot2:" ¬ (∃(a', b', c')∈set les. a' ≠ 0 ∧ 4 * a' * c' ≤ b'⇧2 ∧ (∀(d, e, f)∈set les. ∃y'>(- b' - sqrt (b'⇧2 - 4 * a' * c')) / (2 * a'). ∀x∈{(- b' - sqrt (b'⇧2 - 4 * a' * c')) / (2 * a')<..y'}. d * x⇧2 + e * x + f < 0))" using big by auto have nok: "¬ (∃k. ∃(a, b, c)∈set les. a*k^2 + b*k + c = 0 ∧ (∀(d, e, f)∈set les. ∃y'>k. ∀x∈{k<..y'}. d * x⇧2 + e * x + f < 0))" proof - have "(∃k. ∃(a, b, c)∈set les. a*k^2 + b*k + c = 0 ∧ (∀(d, e, f)∈set les. ∃y'>k. ∀x∈{k<..y'}. d * x⇧2 + e * x + f < 0)) ⟹ False" proof - assume "(∃k. ∃(a, b, c)∈set les. a*k^2 + b*k + c = 0 ∧ (∀(d, e, f)∈set les. ∃y'>k. ∀x∈{k<..y'}. d * x⇧2 + e * x + f < 0))" then obtain k a b c where k_prop: "(a, b, c) ∈ set les ∧ a*k^2 + b*k + c = 0 ∧ (∀(d, e, f)∈set les. ∃y'>k. ∀x∈{k<..y'}. d * x⇧2 + e * x + f < 0)" by auto have azer: "a = 0 ⟹ False" proof - assume azer: "a = 0" then have "b = 0 ⟹ c = 0" using k_prop by auto then have bnonz: "b≠ 0" using azer x_prop k_prop by auto then have "k = -c/b" using k_prop azer by (metis (no_types, hide_lams) add.commute add.left_neutral add_uminus_conv_diff diff_le_0_iff_le divide_non_zero less_eq_real_def mult_zero_left neg_less_iff_less order_less_irrefl real_add_less_0_iff) then have " (∃(a', b', c')∈set les. a' = 0 ∧ b' ≠ 0 ∧ (∀(d, e, f)∈set les. ∃y'>- (c' / b'). ∀x∈{- (c' / b')<..y'}. d * x⇧2 + e * x + f < 0))" using k_prop azer bnonz by auto then show "False" using notlinroot by auto qed have anonz: "a ≠ 0 ⟹ False" proof - assume anonz: "a ≠ 0 " let ?r1 = "(- b - sqrt (b^2 - 4 * a * c)) / (2 * a)" let ?r2 = "(- b + sqrt (b^2 - 4 * a * c)) / (2 * a)" have discr: "4 * a * c ≤ b^2" using anonz k_prop discriminant_negative[of a b c] unfolding discrim_def by fastforce then have "k = ?r1 ∨ k = ?r2" using k_prop discriminant_nonneg[of a b c] unfolding discrim_def using anonz by auto then have "(∃(a', b', c')∈set les. a' ≠ 0 ∧ 4 * a' * c' ≤ b'⇧2 ∧ (∀(d, e, f)∈set les. ∃y'>(sqrt (b'⇧2 - 4 * a' * c') - b') / (2 * a'). ∀x∈{(sqrt (b'⇧2 - 4 * a' * c') - b') / (2 * a')<..y'}. d * x⇧2 + e * x + f < 0)) ∨ (∃(a', b', c')∈set les. a' ≠ 0 ∧ 4 * a' * c' ≤ b'⇧2 ∧ (∀(d, e, f)∈set les. ∃y'>(- b' - sqrt (b'⇧2 - 4 * a' * c')) / (2 * a'). ∀x∈{(- b' - sqrt (b'⇧2 - 4 * a' * c')) / (2 * a')<..y'}. d * x⇧2 + e * x + f < 0))" using discr anonz notquadroot1 notquadroot2 k_prop by auto then show "False" using notquadroot1 notquadroot2 by auto qed show "False" using azer anonz by auto qed then show ?thesis by auto qed have finset: "finite (set les)" by blast have h1: "(∃(a, b, c)∈set les. a = 0 ∧ b = 0 ∧ c = 0) ⟹ False" using x_prop by fastforce then have h2: "¬(∃(a, b, c)∈set les. a = 0 ∧ b = 0 ∧ c = 0) ⟹ False" proof - assume nozer: "¬(∃(a, b, c)∈set les. a = 0 ∧ b = 0 ∧ c = 0)" then have same_set: "root_set (set les) = set (sorted_root_list_set (set les))" using root_set_finite finset set_sorted_list_of_set by (simp add: nozer root_set_finite sorted_root_list_set_def) have xnotin: "x ∉ root_set (set les)" unfolding root_set_def using x_prop by auto let ?srl = "sorted_root_list_set (set les)" have notinlist: "¬ List.member ?srl x" using xnotin same_set by (simp add: in_set_member) then have notmem: "∀n < (length ?srl). x ≠ nth_default 0 ?srl n" using nth_mem same_set xnotin nth_default_def by metis show ?thesis proof (induct ?srl) case Nil then have "(∀(a, b, c)∈set les. ∃x. ∀y<x. a * y⇧2 + b * y + c < 0)" proof clarsimp fix a b c assume noroots: "[] = sorted_root_list_set (set les)" assume inset: "(a, b, c) ∈ set les" have "{} = root_set (set les)" using noroots same_set by auto then have nozero: "¬(∃x. a*x^2 + b*x + c = 0)" using inset unfolding root_set_def by auto have "∀y<x. a * y⇧2 + b * y + c < 0" proof clarsimp fix y assume "y < x" then have "sign_num (a*x^2 + b*x + c) = sign_num (a*y^2 + b*y + c)" using nozero by (metis changes_sign_var) then show "a * y⇧2 + b * y + c < 0" unfolding sign_num_def using x_prop inset by (smt split_conv) qed then show "∃x. ∀y<x. a * y⇧2 + b * y + c < 0" by auto qed then show ?case using notneginf by auto next case (Cons w xa) (* Need to argue that x isn't greater than the largest element of ?srl *) (* that if srl has length ≥ 2, x isn't in between any of the roots of ?srl*) (* and that x isn't less than the lowest root in ?srl *) then have lengthsrl: "length ?srl > 0" by auto have neginf: "x < nth_default 0 ?srl 0 ⟹ False" proof - assume xlt: "x < nth_default 0 ?srl 0" have all: "(∀(a, b, c)∈set les. ∀y<x. a * y⇧2 + b * y + c < 0)" proof clarsimp fix a b c y assume inset: "(a, b, c) ∈ set les" assume "y < x" have xl: "a*x^2 + b*x + c < 0" using x_prop inset by auto have "¬(∃q. q < nth_default 0 ?srl 0 ∧ a*q^2 + b*q + c = 0)" proof - have "(∃q. q < nth_default 0 ?srl 0 ∧ a*q^2 + b*q + c = 0) ⟹ False" proof - assume "∃q. q < nth_default 0 ?srl 0 ∧ a*q^2 + b*q + c = 0" then obtain q where q_prop: "q < nth_default 0 ?srl 0 ∧a*q^2 + b*q + c = 0" by auto then have " q ∈ root_set (set les)" unfolding root_set_def using inset by auto then have "List.member ?srl q" using same_set by (simp add: in_set_member) then have "q ≥ nth_default 0 ?srl 0" using sorted_sorted_list_of_set[where A = "root_set (set les)"] unfolding sorted_root_list_set_def by (metis ‹q ∈ root_set (set les)› in_set_conv_nth le_less_linear lengthsrl not_less0 nth_default_nth same_set sorted_nth_mono sorted_root_list_set_def) then show "False" using q_prop by auto qed then show ?thesis by auto qed then have "¬(∃q. q < x ∧ a*q^2 + b*q + c = 0)" using xlt by auto then show " a * y⇧2 + b * y + c < 0" using xl changes_sign_var[where a = "a", where b = "b", where c = "c", where x = "y", where y = "x"] unfolding sign_num_def using ‹y < x› less_eq_real_def zero_neq_numeral by fastforce qed have "(∀(a, b, c)∈set les. ∃x. ∀y<x. a * y⇧2 + b * y + c < 0)" proof clarsimp fix a b c assume "(a, b, c)∈set les" then show "∃x. ∀y<x. a * y⇧2 + b * y + c < 0" using all by blast qed then show "False" using notneginf by auto qed have "x > nth_default 0 ?srl (length ?srl - 1) ⟹ (∃k. ∃(a, b, c)∈set les. a*k^2 + b*k + c = 0 ∧ (∀(d, e, f)∈set les. ∃y'>k. ∀x∈{k<..y'}. d * x⇧2 + e * x + f < 0))" proof - assume xgt: "x > nth_default 0 ?srl (length ?srl - 1)" let ?lg = "nth_default 0 ?srl (length ?srl - 1)" have "List.member ?srl ?lg" by (metis diff_less in_set_member lengthsrl nth_default_def nth_mem zero_less_one) then have "?lg ∈ root_set (set les) " using same_set in_set_member[of ?lg ?srl] by auto then have exabc: "∃(a, b, c)∈set les. a*?lg^2 + b*?lg + c = 0" unfolding root_set_def by auto have "(∀(d, e, f)∈set les. ∀q∈{?lg<..x}. d * q^2 + e * q + f < 0)" proof clarsimp fix d e f q assume inset: "(d, e, f) ∈ set les" assume qgt: "(nth_default 0) (sorted_root_list_set (set les)) (length (sorted_root_list_set (set les)) - Suc 0) < q" assume qlt: "q ≤ x" have nor: "¬(∃r. d * r^2 + e * r + f = 0 ∧ r > ?lg)" proof - have "(∃r. d * r^2 + e * r + f = 0 ∧ r > ?lg) ⟹ False " proof - assume "∃r. d * r^2 + e * r + f = 0 ∧ r > ?lg" then obtain r where r_prop: "d*r^2 + e*r + f = 0 ∧ r > ?lg" by auto then have "r ∈ root_set (set les)" using inset unfolding root_set_def by auto then have "List.member ?srl r" using same_set in_set_member by (simp add: in_set_member) then have " r ≤ ?lg" using sorted_sorted_list_of_set nth_default_def by (metis One_nat_def Suc_pred ‹r ∈ root_set (set les)› in_set_conv_nth lengthsrl lessI less_Suc_eq_le same_set sorted_nth_mono sorted_root_list_set_def) then show "False" using r_prop by auto qed then show ?thesis by auto qed then have xltz_helper: "¬(∃r. r ≥ q ∧ d * r^2 + e * r + f = 0)" using qgt by auto then have xltz: "d*x^2 + e*x + f < 0" using inset x_prop by auto show "d * q⇧2 + e * q + f < 0" using qlt qgt nor changes_sign_var[of d _ e f _] xltz xltz_helper unfolding sign_num_def apply (auto) by smt qed then have " (∀(d, e, f)∈set les. ∃y'>?lg. ∀x∈{?lg<..y'}. d * x⇧2 + e * x + f < 0)" using xgt by auto then have "(∃(a, b, c)∈set les. a*?lg^2 + b*?lg + c = 0 ∧ (∀(d, e, f)∈set les. ∃y'>?lg. ∀x∈{?lg<..y'}. d * x⇧2 + e * x + f < 0))" using exabc by auto then show "(∃k. ∃(a, b, c)∈set les. a*k^2 + b*k + c = 0 ∧ (∀(d, e, f)∈set les. ∃y'>k. ∀x∈{k<..y'}. d * x⇧2 + e * x + f < 0))" by auto qed then have posinf: "x > nth_default 0 ?srl (length ?srl - 1) ⟹ False" using nok by auto have "(∃n. (n+1) < (length ?srl) ∧ x > (nth_default 0 ?srl) n ∧ x < (nth_default 0 ?srl (n + 1))) ⟹ (∃k. ∃(a, b, c)∈set les. a*k^2 + b*k + c = 0 ∧ (∀(d, e, f)∈set les. ∃y'>k. ∀x∈{k<..y'}. d * x⇧2 + e * x + f < 0))" proof - assume "∃n. (n+1) < (length ?srl) ∧ x > nth_default 0 ?srl n ∧ x < nth_default 0 ?srl (n + 1)" then obtain n where n_prop: "(n+1) < (length ?srl) ∧ x > nth_default 0 ?srl n ∧ x < nth_default 0 ?srl (n + 1)" by auto let ?elt = "nth_default 0 ?srl n" let ?elt2 = "nth_default 0 ?srl (n + 1)" have "List.member ?srl ?elt" using n_prop nth_default_def by (metis add_lessD1 in_set_member nth_mem) then have "?elt ∈ root_set (set les) " using same_set in_set_member[of ?elt ?srl] by auto then have exabc: "∃(a, b, c)∈set les. a*?elt^2 + b*?elt + c = 0" unfolding root_set_def by auto then obtain a b c where "(a, b, c)∈set les ∧ a*?elt^2 + b*?elt + c = 0" by auto have xltel2: "x < ?elt2" using n_prop by auto have xgtel: "x > ?elt " using n_prop by auto have "(∀(d, e, f)∈set les. ∀q∈{?elt<..x}. d * q^2 + e * q + f < 0)" proof clarsimp fix d e f q assume inset: "(d, e, f) ∈ set les" assume qgt: "nth_default 0 (sorted_root_list_set (set les)) n < q" assume qlt: "q ≤ x" have nor: "¬(∃r. d * r^2 + e * r + f = 0 ∧ r > ?elt ∧r < ?elt2)" proof - have "(∃r. d * r^2 + e * r + f = 0 ∧ r > ?elt ∧ r < ?elt2) ⟹ False " proof - assume "∃r. d * r^2 + e * r + f = 0 ∧ r > ?elt ∧ r < ?elt2" then obtain r where r_prop: "d*r^2 + e*r + f = 0 ∧ r > ?elt ∧ r < ?elt2" by auto then have "r ∈ root_set (set les)" using inset unfolding root_set_def by auto then have "List.member ?srl r" using same_set in_set_member by (simp add: in_set_member) then have "∃i < (length ?srl). r = nth_default 0 ?srl i" by (metis ‹r ∈ root_set (set les)› in_set_conv_nth same_set nth_default_def) then obtain i where i_prop: "i < (length ?srl) ∧ r = nth_default 0 ?srl i" by auto have "r > ?elt" using r_prop by auto then have igt: " i > n" using i_prop sorted_sorted_list_of_set by (smt add_lessD1 leI n_prop nth_default_def sorted_nth_mono sorted_root_list_set_def) have "r < ?elt2" using r_prop by auto then have ilt: " i < n + 1" using i_prop sorted_sorted_list_of_set by (smt leI n_prop nth_default_def sorted_nth_mono sorted_root_list_set_def) then show "False" using igt ilt by auto qed then show ?thesis by auto qed then have nor: "¬(∃r. d * r^2 + e * r + f = 0 ∧ r > ?elt ∧r ≤ x)" using xltel2 xgtel by auto then have xltz: "d*x^2 + e*x + f < 0" using inset x_prop by auto show "d * q⇧2 + e * q + f < 0" using qlt qgt nor changes_sign_var[of d _ e f _] xltz unfolding sign_num_def by smt qed then have " (∀(d, e, f)∈set les. ∃y'>?elt. ∀x∈{?elt<..y'}. d * x⇧2 + e * x + f < 0)" using xgtel xltel2 by auto then have "(∃(a, b, c)∈set les. a*?elt^2 + b*?elt + c = 0 ∧ (∀(d, e, f)∈set les. ∃y'>?elt. ∀x∈{?elt<..y'}. d * x⇧2 + e * x + f < 0))" using exabc by auto then show "(∃k. ∃(a, b, c)∈set les. a*k^2 + b*k + c = 0 ∧ (∀(d, e, f)∈set les. ∃y'>k. ∀x∈{k<..y'}. d * x⇧2 + e * x + f < 0))" by auto qed then have inbetw: "(∃n. (n+1) < (length ?srl) ∧ x > nth_default 0 ?srl n ∧ x < nth_default 0 ?srl (n + 1)) ⟹ False" using nok by auto have lenzer: "length xa = 0 ⟹ False" proof - assume "length xa = 0" have xis: "x > w ∨ x < w" using notmem Cons.hyps by (smt list.set_intros(1) same_set xnotin) have xgt: "x > w ⟹ False" proof - assume xgt: "x > w" show "False" using posinf Cons.hyps by (metis One_nat_def Suc_eq_plus1 ‹length xa = 0› cancel_comm_monoid_add_class.diff_cancel list.size(4) nth_default_Cons_0 xgt) qed have xlt: "x < w ⟹ False" proof - assume xlt: "x < w" show "False" using neginf Cons.hyps by (metis nth_default_Cons_0 xlt) qed show "False" using xis xgt xlt by auto qed have lengt: "length xa > 0 ⟹ False" proof - assume "length xa > 0" have "x ≥ nth_default 0 ?srl 0" using neginf by fastforce then have xgtf: "x > nth_default 0 ?srl 0" using notmem using Cons.hyps(2) by fastforce have "x ≤ nth_default 0 ?srl (length ?srl - 1)" using posinf by fastforce then have "(∃n. (n+1) < (length ?srl) ∧ x ≥ nth_default 0 ?srl n ∧ x ≤ nth_default 0 ?srl (n + 1))" using lengthsrl xgtf notmem sorted_list_prop[where l = ?srl, where x = "x"] by (metis add_lessD1 diff_less nth_default_nth sorted_root_list_set_def sorted_sorted_list_of_set zero_less_one) then obtain n where n_prop: "(n+1) < (length ?srl) ∧ x ≥ nth_default 0 ?srl n ∧ x ≤ nth_default 0 ?srl (n + 1)" by auto then have "x > nth_default 0 ?srl n ∧ x < nth_default 0 ?srl (n+1)" using notmem by (metis Suc_eq_plus1 Suc_lessD less_eq_real_def) then have "(∃n. (n+1) < (length ?srl) ∧ x > nth_default 0 ?srl n ∧ x < nth_default 0 ?srl (n + 1))" using n_prop by blast then show "False" using inbetw by auto qed then show ?case using lenzer lengt by auto qed qed show "False" using h1 h2 by auto qed then have equiv_false: "¬((∀(a, b, c)∈set les. ∃x. ∀y<x. a * y⇧2 + b * y + c < 0) ∨ (∃(a', b', c')∈set les. a' = 0 ∧ b' ≠ 0 ∧ (∀(d, e, f)∈set les. ∃y'>- (c' / b'). ∀x∈{- (c' / b')<..y'}. d * x⇧2 + e * x + f < 0)) ∨ (∃(a', b', c')∈set les. a' ≠ 0 ∧ 4 * a' * c' ≤ b'⇧2 ∧ (∀(d, e, f)∈set les. ∃y'>(sqrt (b'⇧2 - 4 * a' * c') - b') / (2 * a'). ∀x∈{(sqrt (b'⇧2 - 4 * a' * c') - b') / (2 * a')<..y'}. d * x⇧2 + e * x + f < 0)) ∨ (∃(a', b', c')∈set les. a' ≠ 0 ∧ 4 * a' * c' ≤ b'⇧2 ∧ (∀(d, e, f)∈set les. ∃y'>(- b' - sqrt (b'⇧2 - 4 * a' * c')) / (2 * a'). ∀x∈{(- b' - sqrt (b'⇧2 - 4 * a' * c')) / (2 * a')<..y'}. d * x⇧2 + e * x + f < 0))) ⟹ False" by linarith have "¬((∀(a, b, c)∈set les. ∃x. ∀y<x. a * y⇧2 + b * y + c < 0) ∨ (∃(a', b', c')∈set les. a' = 0 ∧ b' ≠ 0 ∧ (∀(d, e, f)∈set les. ∃y'>- (c' / b'). ∀x∈{- (c' / b')<..y'}. d * x⇧2 + e * x + f < 0) ∨ a' ≠ 0 ∧ 4 * a' * c' ≤ b'⇧2 ∧ ((∀(d, e, f)∈set les. ∃y'>(sqrt (b'⇧2 - 4 * a' * c') - b') / (2 * a'). ∀x∈{(sqrt (b'⇧2 - 4 * a' * c') - b') / (2 * a')<..y'}. d * x⇧2 + e * x + f < 0) ∨ (∀(d, e, f)∈set les. ∃y'>(- b' - sqrt (b'⇧2 - 4 * a' * c')) / (2 * a'). ∀x∈{(- b' - sqrt (b'⇧2 - 4 * a' * c')) / (2 * a')<..y'}. d * x⇧2 + e * x + f < 0)))) ⟹ False" proof - assume "¬((∀(a, b, c)∈set les. ∃x. ∀y<x. a * y⇧2 + b * y + c < 0) ∨ (∃(a', b', c')∈set les. a' = 0 ∧ b' ≠ 0 ∧ (∀(d, e, f)∈set les. ∃y'>- (c' / b'). ∀x∈{- (c' / b')<..y'}. d * x⇧2 + e * x + f < 0) ∨ a' ≠ 0 ∧ 4 * a' * c' ≤ b'⇧2 ∧ ((∀(d, e, f)∈set les. ∃y'>(sqrt (b'⇧2 - 4 * a' * c') - b') / (2 * a'). ∀x∈{(sqrt (b'⇧2 - 4 * a' * c') - b') / (2 * a')<..y'}. d * x⇧2 + e * x + f < 0) ∨ (∀(d, e, f)∈set les. ∃y'>(- b' - sqrt (b'⇧2 - 4 * a' * c')) / (2 * a'). ∀x∈{(- b' - sqrt (b'⇧2 - 4 * a' * c')) / (2 * a')<..y'}. d * x⇧2 + e * x + f < 0))))" then have "¬((∀(a, b, c)∈set les. ∃x. ∀y<x. a * y⇧2 + b * y + c < 0) ∨ (∃(a', b', c')∈set les. a' = 0 ∧ b' ≠ 0 ∧ (∀(d, e, f)∈set les. ∃y'>- (c' / b'). ∀x∈{- (c' / b')<..y'}. d * x⇧2 + e * x + f < 0)) ∨ (∃(a', b', c')∈set les. a' ≠ 0 ∧ 4 * a' * c' ≤ b'⇧2 ∧ (∀(d, e, f)∈set les. ∃y'>(sqrt (b'⇧2 - 4 * a' * c') - b') / (2 * a'). ∀x∈{(sqrt (b'⇧2 - 4 * a' * c') - b') / (2 * a')<..y'}. d * x⇧2 + e * x + f < 0)) ∨ (∃(a', b', c')∈set les. a' ≠ 0 ∧ 4 * a' * c' ≤ b'⇧2 ∧ (∀(d, e, f)∈set les. ∃y'>(- b' - sqrt (b'⇧2 - 4 * a' * c')) / (2 * a'). ∀x∈{(- b' - sqrt (b'⇧2 - 4 * a' * c')) / (2 * a')<..y'}. d * x⇧2 + e * x + f < 0)))" by auto then show ?thesis using equiv_false by auto qed then show ?thesis by blast qed lemma les_qe : shows "(∃x. (∀(a, b, c)∈set les. a * x⇧2 + b * x + c < 0)) = ((∀(a, b, c)∈set les. ∃x. ∀y<x. a * y⇧2 + b * y + c < 0) ∨ (∃(a', b', c')∈set les. a' = 0 ∧ b' ≠ 0 ∧ (∀(d, e, f)∈set les. ∃y'>- (c' / b'). ∀x∈{- (c' / b')<..y'}. d * x⇧2 + e * x + f < 0) ∨ a' ≠ 0 ∧ 4 * a' * c' ≤ b'⇧2 ∧ ((∀(d, e, f)∈set les. ∃y'>(sqrt (b'⇧2 - 4 * a' * c') - b') / (2 * a'). ∀x∈{(sqrt (b'⇧2 - 4 * a' * c') - b') / (2 * a')<..y'}. d * x⇧2 + e * x + f < 0) ∨ (∀(d, e, f)∈set les. ∃y'>(- b' - sqrt (b'⇧2 - 4 * a' * c')) / (2 * a'). ∀x∈{(- b' - sqrt (b'⇧2 - 4 * a' * c')) / (2 * a')<..y'}. d * x⇧2 + e * x + f < 0))))" proof - have first: "(∃x. (∀(a, b, c)∈set les. a * x⇧2 + b * x + c < 0)) ⟶ ((∀(a, b, c)∈set les. ∃x. ∀y<x. a * y⇧2 + b * y + c < 0) ∨ (∃(a', b', c')∈set les. a' = 0 ∧ b' ≠ 0 ∧ (∀(d, e, f)∈set les. ∃y'>- (c' / b'). ∀x∈{- (c' / b')<..y'}. d * x⇧2 + e * x + f < 0) ∨ a' ≠ 0 ∧ 4 * a' * c' ≤ b'⇧2 ∧ ((∀(d, e, f)∈set les. ∃y'>(sqrt (b'⇧2 - 4 * a' * c') - b') / (2 * a'). ∀x∈{(sqrt (b'⇧2 - 4 * a' * c') - b') / (2 * a')<..y'}. d * x⇧2 + e * x + f < 0) ∨ (∀(d, e, f)∈set les. ∃y'>(- b' - sqrt (b'⇧2 - 4 * a' * c')) / (2 * a'). ∀x∈{(- b' - sqrt (b'⇧2 - 4 * a' * c')) / (2 * a')<..y'}. d * x⇧2 + e * x + f < 0))))" using les_qe_backward by auto have second: "((∀(a, b, c)∈set les. ∃x. ∀y<x. a * y⇧2 + b * y + c < 0) ∨ (∃(a', b', c')∈set les. a' = 0 ∧ b' ≠ 0 ∧ (∀(d, e, f)∈set les. ∃y'>- (c' / b'). ∀x∈{- (c' / b')<..y'}. d * x⇧2 + e * x + f < 0) ∨ a' ≠ 0 ∧ 4 * a' * c' ≤ b'⇧2 ∧ ((∀(d, e, f)∈set les. ∃y'>(sqrt (b'⇧2 - 4 * a' * c') - b') / (2 * a'). ∀x∈{(sqrt (b'⇧2 - 4 * a' * c') - b') / (2 * a')<..y'}. d * x⇧2 + e * x + f < 0) ∨ (∀(d, e, f)∈set les. ∃y'>(- b' - sqrt (b'⇧2 - 4 * a' * c')) / (2 * a'). ∀x∈{(- b' - sqrt (b'⇧2 - 4 * a' * c')) / (2 * a')<..y'}. d * x⇧2 + e * x + f < 0)))) ⟶ (∃x. (∀(a, b, c)∈set les. a * x⇧2 + b * x + c < 0)) " using les_qe_forward by auto have "(∃x. (∀(a, b, c)∈set les. a * x⇧2 + b * x + c < 0)) ⟷ ((∀(a, b, c)∈set les. ∃x. ∀y<x. a * y⇧2 + b * y + c < 0) ∨ (∃(a', b', c')∈set les. a' = 0 ∧ b' ≠ 0 ∧ (∀(d, e, f)∈set les. ∃y'>- (c' / b'). ∀x∈{- (c' / b')<..y'}. d * x⇧2 + e * x + f < 0) ∨ a' ≠ 0 ∧ 4 * a' * c' ≤ b'⇧2 ∧ ((∀(d, e, f)∈set les. ∃y'>(sqrt (b'⇧2 - 4 * a' * c') - b') / (2 * a'). ∀x∈{(sqrt (b'⇧2 - 4 * a' * c') - b') / (2 * a')<..y'}. d * x⇧2 + e * x + f < 0) ∨ (∀(d, e, f)∈set les. ∃y'>(- b' - sqrt (b'⇧2 - 4 * a' * c')) / (2 * a'). ∀x∈{(- b' - sqrt (b'⇧2 - 4 * a' * c')) / (2 * a')<..y'}. d * x⇧2 + e * x + f < 0))))" using first second by meson then show ?thesis by blast qed subsubsection "equiv\\_lemma" lemma equiv_lemma: assumes big_asm: "(∃(a', b', c')∈set eq. (a' = 0 ∧ b' ≠ 0) ∧ (∀(d, e, f)∈set eq. d * (- c' / b')⇧2 + e * (- c' / b') + f = 0) ∧ (∀(d, e, f)∈set les. d * (- c' / b')⇧2 + e * (- c' / b') + f < 0)) ∨ (∃(a', b', c')∈set eq. a' ≠ 0 ∧ - b'⇧2 + 4 * a' * c' ≤ 0 ∧ ((∀(d, e, f)∈set eq. d * ((- b' + 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a'))⇧2 + e * ((- b' + 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a')) + f = 0) ∧ (∀(d, e, f)∈set les. d * ((- b' + 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a'))⇧2 + e * ((- b' + 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a')) + f < 0))) ∨ (∃(a', b', c')∈set eq. a' ≠ 0 ∧ - b'⇧2 + 4 * a' * c' ≤ 0 ∧ (∀(d, e, f)∈set eq. d * ((- b' + - 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a'))⇧2 + e * ((- b' + - 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a')) + f = 0) ∧ (∀(d, e, f)∈set les. d * ((- b' + - 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a'))⇧2 + e * ((- b' + - 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a')) + f < 0)) ∨ ((∀(d, e, f)∈set eq. d = 0 ∧ e = 0 ∧ f = 0) ∧ (∃x. ∀(a, b, c)∈set les. a * x⇧2 + b * x + c < 0))" shows "((∃(a', b', c')∈set eq. (a' = 0 ∧ b' ≠ 0) ∧ (∀(d, e, f)∈set eq. d * (- c' / b')⇧2 + e * (- c' / b') + f = 0) ∧ (∀(d, e, f)∈set les. d * (- c' / b')⇧2 + e * (- c' / b') + f < 0) ∨ a' ≠ 0 ∧ - b'⇧2 + 4 * a' * c' ≤ 0 ∧ ((∀(d, e, f)∈set eq. d * ((- b' + 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a'))⇧2 + e * ((- b' + 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a')) + f = 0) ∧ (∀(d, e, f)∈set les. d * ((- b' + 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a'))⇧2 + e * ((- b' + 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a')) + f < 0) ∨ (∀(d, e, f)∈set eq. d * ((- b' + - 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a'))⇧2 + e * ((- b' + - 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a')) + f = 0) ∧ (∀(d, e, f)∈set les. d * ((- b' + - 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a'))⇧2 + e * ((- b' + - 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a')) + f < 0))) ∨ (∀(d, e, f)∈set eq. d = 0 ∧ e = 0 ∧ f = 0) ∧ (∃x. ∀(a, b, c)∈set les. a * x⇧2 + b * x + c < 0))" proof - let ?t = " ((∃(a', b', c')∈set eq. (a' = 0 ∧ b' ≠ 0) ∧ (∀(d, e, f)∈set eq. d * (- c' / b')⇧2 + e * (- c' / b') + f = 0) ∧ (∀(d, e, f)∈set les. d * (- c' / b')⇧2 + e * (- c' / b') + f < 0) ∨ a' ≠ 0 ∧ - b'⇧2 + 4 * a' * c' ≤ 0 ∧ ((∀(d, e, f)∈set eq. d * ((- b' + 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a'))⇧2 + e * ((- b' + 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a')) + f = 0) ∧ (∀(d, e, f)∈set les. d * ((- b' + 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a'))⇧2 + e * ((- b' + 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a')) + f < 0) ∨ (∀(d, e, f)∈set eq. d * ((- b' + - 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a'))⇧2 + e * ((- b' + - 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a')) + f = 0) ∧ (∀(d, e, f)∈set les. d * ((- b' + - 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a'))⇧2 + e * ((- b' + - 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a')) + f < 0))) ∨ (∀(d, e, f)∈set eq. d = 0 ∧ e = 0 ∧ f = 0) ∧ (∃x. ∀(a, b, c)∈set les. a * x⇧2 + b * x + c < 0))" have h1: "(∃(a', b', c')∈set eq. (a' = 0 ∧ b' ≠ 0) ∧ (∀(d, e, f)∈set eq. d * (- c' / b')⇧2 + e * (- c' / b') + f = 0) ∧ (∀(d, e, f)∈set les. d * (- c' / b')⇧2 + e * (- c' / b') + f < 0)) ⟹ ?t" by auto have h2: "(∃(a', b', c')∈set eq. a' ≠ 0 ∧ - b'⇧2 + 4 * a' * c' ≤ 0 ∧ ((∀(d, e, f)∈set eq. d * ((- b' + 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a'))⇧2 + e * ((- b' + 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a')) + f = 0) ∧ (∀(d, e, f)∈set les. d * ((- b' + 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a'))⇧2 + e * ((- b' + 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a')) + f < 0))) ⟹ ?t" by auto have h3: "(∃(a', b', c')∈set eq. a' ≠ 0 ∧ - b'⇧2 + 4 * a' * c' ≤ 0 ∧ (∀(d, e, f)∈set eq. d * ((- b' + - 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a'))⇧2 + e * ((- b' + - 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a')) + f = 0) ∧ (∀(d, e, f)∈set les. d * ((- b' + - 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a'))⇧2 + e * ((- b' + - 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a')) + f < 0)) ⟹ ?t" by auto show ?thesis using big_asm h1 h2 h3 by presburger qed subsubsection "The eq\\_qe lemma" lemma eq_qe_forwards: shows "(∃x. (∀(a, b, c)∈set eq. a * x⇧2 + b * x + c = 0) ∧ (∀(a, b, c)∈set les. a * x⇧2 + b * x + c < 0)) ⟹ ((∃(a', b', c')∈set eq. (a' = 0 ∧ b' ≠ 0) ∧ (∀(d, e, f)∈set eq. d * (- c' / b')⇧2 + e * (- c' / b') + f = 0) ∧ (∀(d, e, f)∈set les. d * (- c' / b')⇧2 + e * (- c' / b') + f < 0) ∨ a' ≠ 0 ∧ - b'⇧2 + 4 * a' * c' ≤ 0 ∧ ((∀(d, e, f)∈set eq. d * ((- b' + 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a'))⇧2 + e * ((- b' + 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a')) + f = 0) ∧ (∀(d, e, f)∈set les. d * ((- b' + 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a'))⇧2 + e * ((- b' + 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a')) + f < 0) ∨ (∀(d, e, f)∈set eq. d * ((- b' + - 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a'))⇧2 + e * ((- b' + - 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a')) + f = 0) ∧ (∀(d, e, f)∈set les. d * ((- b' + - 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a'))⇧2 + e * ((- b' + - 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a')) + f < 0))) ∨ (∀(d, e, f)∈set eq. d = 0 ∧ e = 0 ∧ f = 0) ∧ (∃x. ∀(a, b, c)∈set les. a * x⇧2 + b * x + c < 0))" proof - let ?big_or = "(∃(a', b', c')∈set eq. (a' = 0 ∧ b' ≠ 0) ∧ (∀(d, e, f)∈set eq. d * (- c' / b')⇧2 + e * (- c' / b') + f = 0) ∧ (∀(d, e, f)∈set les. d * (- c' / b')⇧2 + e * (- c' / b') + f < 0)) ∨ (∃(a', b', c')∈set eq. a' ≠ 0 ∧ - b'⇧2 + 4 * a' * c' ≤ 0 ∧ ((∀(d, e, f)∈set eq. d * ((- b' + 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a'))⇧2 + e * ((- b' + 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a')) + f = 0) ∧ (∀(d, e, f)∈set les. d * ((- b' + 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a'))⇧2 + e * ((- b' + 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a')) + f < 0))) ∨ (∃(a', b', c')∈set eq. a' ≠ 0 ∧ - b'⇧2 + 4 * a' * c' ≤ 0 ∧ (∀(d, e, f)∈set eq. d * ((- b' + - 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a'))⇧2 + e * ((- b' + - 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a')) + f = 0) ∧ (∀(d, e, f)∈set les. d * ((- b' + - 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a'))⇧2 + e * ((- b' + - 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a')) + f < 0)) ∨ ((∀(d, e, f)∈set eq. d = 0 ∧ e = 0 ∧ f = 0) ∧ (∃x. ∀(a, b, c)∈set les. a * x⇧2 + b * x + c < 0))" assume asm: "(∃x. (∀(a, b, c)∈set eq. a * x⇧2 + b * x + c = 0) ∧ (∀(a, b, c)∈set les. a * x⇧2 + b * x + c < 0)) " then obtain x where x_prop: "(∀(a, b, c)∈set eq. a * x⇧2 + b * x + c = 0) ∧ (∀(a, b, c)∈set les. a * x⇧2 + b * x + c < 0)" by auto have "¬ (∃(a', b', c')∈set eq. (a' = 0 ∧ b' ≠ 0) ∧ (∀(d, e, f)∈set eq. d * (- c' / b')⇧2 + e * (- c' / b') + f = 0) ∧ (∀(d, e, f)∈set les. d * (- c' / b')⇧2 + e * (- c' / b') + f < 0)) ∧ ¬ (∃(a', b', c')∈set eq. a' ≠ 0 ∧ - b'⇧2 + 4 * a' * c' ≤ 0 ∧ ((∀(d, e, f)∈set eq. d * ((- b' + 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a'))⇧2 + e * ((- b' + 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a')) + f = 0) ∧ (∀(d, e, f)∈set les. d * ((- b' + 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a'))⇧2 + e * ((- b' + 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a')) + f < 0))) ∧ ¬ (∃(a', b', c')∈set eq. a' ≠ 0 ∧ - b'⇧2 + 4 * a' * c' ≤ 0 ∧ (∀(d, e, f)∈set eq. d * ((- b' + - 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a'))⇧2 + e * ((- b' + - 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a')) + f = 0) ∧ (∀(d, e, f)∈set les. d * ((- b' + - 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a'))⇧2 + e * ((- b' + - 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a')) + f < 0)) ∧ ¬ ((∀(d, e, f)∈set eq. d = 0 ∧ e = 0 ∧ f = 0) ∧ (∃x. ∀(a, b, c)∈set les. a * x⇧2 + b * x + c < 0)) ⟹ False" proof - assume big_conj: "¬ (∃(a', b', c')∈set eq. (a' = 0 ∧ b' ≠ 0) ∧ (∀(d, e, f)∈set eq. d * (- c' / b')⇧2 + e * (- c' / b') + f = 0) ∧ (∀(d, e, f)∈set les. d * (- c' / b')⇧2 + e * (- c' / b') + f < 0)) ∧ ¬ (∃(a', b', c')∈set eq. a' ≠ 0 ∧ - b'⇧2 + 4 * a' * c' ≤ 0 ∧ ((∀(d, e, f)∈set eq. d * ((- b' + 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a'))⇧2 + e * ((- b' + 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a')) + f = 0) ∧ (∀(d, e, f)∈set les. d * ((- b' + 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a'))⇧2 + e * ((- b' + 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a')) + f < 0))) ∧ ¬ (∃(a', b', c')∈set eq. a' ≠ 0 ∧ - b'⇧2 + 4 * a' * c' ≤ 0 ∧ (∀(d, e, f)∈set eq. d * ((- b' + - 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a'))⇧2 + e * ((- b' + - 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a')) + f = 0) ∧ (∀(d, e, f)∈set les. d * ((- b' + - 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a'))⇧2 + e * ((- b' + - 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a')) + f < 0)) ∧ ¬ ((∀(d, e, f)∈set eq. d = 0 ∧ e = 0 ∧ f = 0) ∧ (∃x. ∀(a, b, c)∈set les. a * x⇧2 + b * x + c < 0))" have not_lin: "¬(∃(a', b', c')∈set eq. (a' = 0 ∧ b' ≠ 0) ∧ (∀(d, e, f)∈set eq. d * (- c' / b')⇧2 + e * (- c' / b') + f = 0) ∧ (∀(d, e, f)∈set les. d * (- c' / b')⇧2 + e * (- c' / b') + f < 0))" using big_conj by auto have not_quad1: "¬(∃(a', b', c')∈set eq. a' ≠ 0 ∧ - b'⇧2 + 4 * a' * c' ≤ 0 ∧ ((∀(d, e, f)∈set eq. d * ((- b' + 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a'))⇧2 + e * ((- b' + 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a')) + f = 0) ∧ (∀(d, e, f)∈set les. d * ((- b' + 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a'))⇧2 + e * ((- b' + 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a')) + f < 0)))" using big_conj by auto have not_quad2: "¬(∃(a', b', c')∈set eq. a' ≠ 0 ∧ - b'⇧2 + 4 * a' * c' ≤ 0 ∧ (∀(d, e, f)∈set eq. d * ((- b' + - 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a'))⇧2 + e * ((- b' + - 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a')) + f = 0) ∧ (∀(d, e, f)∈set les. d * ((- b' + - 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a'))⇧2 + e * ((- b' + - 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a')) + f < 0))" using big_conj by auto have not_zer: "¬((∀(d, e, f)∈set eq. d = 0 ∧ e = 0 ∧ f = 0) ∧ (∃x. ∀(a, b, c)∈set les. a * x⇧2 + b * x + c < 0))" using big_conj by auto then have not_zer1: "¬(∀(d, e, f)∈set eq. d = 0 ∧ e = 0 ∧ f = 0) ∨ ¬ (∃x. ∀(a, b, c)∈set les. a * x⇧2 + b * x + c < 0)" by auto have "(∃x. ∀(a, b, c)∈set les. a * x⇧2 + b * x + c < 0)" using asm by auto then have "¬(∀(d, e, f)∈set eq. d = 0 ∧ e = 0 ∧ f = 0)" using not_zer1 by auto then have "∃ (d, e, f)∈set eq. d ≠ 0 ∨ e ≠ 0 ∨ f ≠ 0 " by auto then obtain d e f where def_prop: "(d, e, f) ∈ set eq ∧ (d ≠ 0 ∨ e ≠ 0 ∨ f ≠ 0)" by auto then have eval_at_x: "d*x^2 + e*x + f = 0" using x_prop by auto have dnonz: "d ≠ 0 ⟹ False" proof - assume dneq: "d ≠ 0" then have discr: "-(e^2) + 4 *d *f ≤ 0" using discriminant_negative[of d e f x] eval_at_x unfolding discrim_def by linarith let ?r1 = "(- e + - 1 * sqrt (e^2 - 4 *d *f)) / (2 * d)" let ?r2 = "(- e + 1 * sqrt (e^2 - 4 *d *f)) / (2 * d)" have xis: "x = ?r1 ∨ x = ?r2" using dneq discr discriminant_nonneg[of d e f x] eval_at_x unfolding discrim_def by auto have xr1: "x = ?r1 ⟹ False" using not_quad2 x_prop discr def_prop dneq by auto have xr2: "x = ?r2 ⟹ False" using not_quad1 x_prop discr def_prop dneq by auto show "False" using xr1 xr2 xis by auto qed then have dz: "d = 0" by auto have enonz: "e ≠ 0 ⟹ False" proof - assume enonz: "e≠ 0" then have "x = -f/e" using dz eval_at_x by (metis add.commute minus_add_cancel mult.commute mult_zero_class.mult_zero_left nonzero_eq_divide_eq) then show "False" using not_lin x_prop enonz dz def_prop by auto qed then have ez: "e = 0" by auto have fnonz: "f ≠ 0 ⟹ False" using ez dz eval_at_x by auto show "False" using def_prop dnonz enonz fnonz by auto qed then have h: "¬(?big_or) ⟹ False" by auto then show ?thesis using equiv_lemma by presburger qed lemma eq_qe_backwards: "((∃(a', b', c')∈set eq. (a' = 0 ∧ b' ≠ 0) ∧ (∀(d, e, f)∈set eq. d * (- c' / b')⇧2 + e * (- c' / b') + f = 0) ∧ (∀(d, e, f)∈set les. d * (- c' / b')⇧2 + e * (- c' / b') + f < 0) ∨ a' ≠ 0 ∧ - b'⇧2 + 4 * a' * c' ≤ 0 ∧ ((∀(d, e, f)∈set eq. d * ((- b' + 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a'))⇧2 + e * ((- b' + 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a')) + f = 0) ∧ (∀(d, e, f)∈set les. d * ((- b' + 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a'))⇧2 + e * ((- b' + 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a')) + f < 0) ∨ (∀(d, e, f)∈set eq. d * ((- b' + - 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a'))⇧2 + e * ((- b' + - 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a')) + f = 0) ∧ (∀(d, e, f)∈set les. d * ((- b' + - 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a'))⇧2 + e * ((- b' + - 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a')) + f < 0))) ∨ (∀(d, e, f)∈set eq. d = 0 ∧ e = 0 ∧ f = 0) ∧ (∃x. ∀(a, b, c)∈set les. a * x⇧2 + b * x + c < 0)) ⟹ (∃x. ((∀(a, b, c)∈set eq. a * x⇧2 + b * x + c = 0) ∧ (∀(a, b, c)∈set les. a * x⇧2 + b * x + c < 0))) " proof - assume "((∃(a', b', c')∈set eq. (a' = 0 ∧ b' ≠ 0) ∧ (∀(d, e, f)∈set eq. d * (- c' / b')⇧2 + e * (- c' / b') + f = 0) ∧ (∀(d, e, f)∈set les. d * (- c' / b')⇧2 + e * (- c' / b') + f < 0) ∨ a' ≠ 0 ∧ - b'⇧2 + 4 * a' * c' ≤ 0 ∧ ((∀(d, e, f)∈set eq. d * ((- b' + 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a'))⇧2 + e * ((- b' + 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a')) + f = 0) ∧ (∀(d, e, f)∈set les. d * ((- b' + 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a'))⇧2 + e * ((- b' + 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a')) + f < 0) ∨ (∀(d, e, f)∈set eq. d * ((- b' + - 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a'))⇧2 + e * ((- b' + - 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a')) + f = 0) ∧ (∀(d, e, f)∈set les. d * ((- b' + - 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a'))⇧2 + e * ((- b' + - 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a')) + f < 0))) ∨ (∀(d, e, f)∈set eq. d = 0 ∧ e = 0 ∧ f = 0) ∧ (∃x. ∀(a, b, c)∈set les. a * x⇧2 + b * x + c < 0))" then have bigor: "(∃(a', b', c')∈set eq. (a' = 0 ∧ b' ≠ 0) ∧ (∀(d, e, f)∈set eq. d * (- c' / b')⇧2 + e * (- c' / b') + f = 0) ∧ (∀(d, e, f)∈set les. d * (- c' / b')⇧2 + e * (- c' / b') + f < 0)) ∨ (∃(a', b', c')∈set eq. a' ≠ 0 ∧ - b'⇧2 + 4 * a' * c' ≤ 0 ∧ ((∀(d, e, f)∈set eq. d * ((- b' + 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a'))⇧2 + e * ((- b' + 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a')) + f = 0) ∧ (∀(d, e, f)∈set les. d * ((- b' + 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a'))⇧2 + e * ((- b' + 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a')) + f < 0))) ∨ (∃(a', b', c')∈set eq. a' ≠ 0 ∧ - b'⇧2 + 4 * a' * c' ≤ 0 ∧ (∀(d, e, f)∈set eq. d * ((- b' + - 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a'))⇧2 + e * ((- b' + - 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a')) + f = 0) ∧ (∀(d, e, f)∈set les. d * ((- b' + - 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a'))⇧2 + e * ((- b' + - 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a')) + f < 0)) ∨ ((∀(d, e, f)∈set eq. d = 0 ∧ e = 0 ∧ f = 0) ∧ (∃x. ∀(a, b, c)∈set les. a * x⇧2 + b * x + c < 0))" by auto have h1: "(∃(a', b', c')∈set eq. (a' = 0 ∧ b' ≠ 0) ∧ (∀(d, e, f)∈set eq. d * (- c' / b')⇧2 + e * (- c' / b') + f = 0) ∧ (∀(d, e, f)∈set les. d * (- c' / b')⇧2 + e * (- c' / b') + f < 0)) ⟹ (∃(x::real). (∀(a, b, c)∈set eq. a * x⇧2 + b * x + c = 0) ∧ (∀(a, b, c)∈set les. a * x⇧2 + b * x + c < 0))" proof - assume "(∃(a', b', c')∈set eq. (a' = 0 ∧ b' ≠ 0) ∧ (∀(d, e, f)∈set eq. d * (- c' / b')⇧2 + e * (- c' / b') + f = 0) ∧ (∀(d, e, f)∈set les. d * (- c' / b')⇧2 + e * (- c' / b') + f < 0))" then obtain a' b' c' where abc_prop: "(a', b', c')∈set eq ∧ (a' = 0 ∧ b' ≠ 0) ∧ (∀(d, e, f)∈set eq. d * (- c' / b')⇧2 + e * (- c' / b') + f = 0) ∧ (∀(d, e, f)∈set les. d * (- c' / b')⇧2 + e * (- c' / b') + f < 0)" by auto let ?x = "(-c' /b')::real" have "(∀(d, e, f)∈set eq. d * ?x⇧2 + e * ?x + f = 0) ∧ (∀(d, e, f)∈set les. d * ?x^2 + e * ?x + f < 0)" using abc_prop by auto then show ?thesis using abc_prop by blast qed have h2: " (∃(a', b', c')∈set eq. a' ≠ 0 ∧ - b'⇧2 + 4 * a' * c' ≤ 0 ∧ ((∀(d, e, f)∈set eq. d * ((- b' + 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a'))⇧2 + e * ((- b' + 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a')) + f = 0) ∧ (∀(d, e, f)∈set les. d * ((- b' + 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a'))⇧2 + e * ((- b' + 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a')) + f < 0))) ⟹ (∃x. (∀(a, b, c)∈set eq. a * x⇧2 + b * x + c = 0) ∧ (∀(a, b, c)∈set les. a * x⇧2 + b * x + c < 0))" proof - assume "(∃(a', b', c')∈set eq. a' ≠ 0 ∧ - b'⇧2 + 4 * a' * c' ≤ 0 ∧ ((∀(d, e, f)∈set eq. d * ((- b' + 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a'))⇧2 + e * ((- b' + 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a')) + f = 0) ∧ (∀(d, e, f)∈set les. d * ((- b' + 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a'))⇧2 + e * ((- b' + 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a')) + f < 0)))" then obtain a' b' c' where abc_prop: "(a', b', c')∈set eq ∧ a' ≠ 0 ∧ - b'⇧2 + 4 * a' * c' ≤ 0 ∧ ((∀(d, e, f)∈set eq. d * ((- b' + 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a'))⇧2 + e * ((- b' + 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a')) + f = 0) ∧ (∀(d, e, f)∈set les. d * ((- b' + 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a'))⇧2 + e * ((- b' + 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a')) + f < 0))" by auto let ?x = "((- b' + 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a')::real)" have anonz: "a' ≠ 0" using abc_prop by auto then have "∃(q::real). q = ?x" by auto then obtain q where q_prop: "q = ?x" by auto have "(∀(d, e, f)∈set eq. d * (?x)⇧2 + e * (?x) + f = 0) ∧ (∀(d, e, f)∈set les. d * (?x)⇧2 + e * (?x) + f < 0)" using abc_prop by auto then have "(∀(d, e, f)∈set eq. d * q⇧2 + e * q + f = 0) ∧ (∀(d, e, f)∈set les. d * q⇧2 + e * q + f < 0)" using q_prop by auto then show ?thesis by auto qed have h3: "(∃(a', b', c')∈set eq. a' ≠ 0 ∧ - b'⇧2 + 4 * a' * c' ≤ 0 ∧ (∀(d, e, f)∈set eq. d * ((- b' + - 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a'))⇧2 + e * ((- b' + - 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a')) + f = 0) ∧ (∀(d, e, f)∈set les. d * ((- b' + - 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a'))⇧2 + e * ((- b' + - 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a')) + f < 0)) ⟹ (∃x. (∀(a, b, c)∈set eq. a * x⇧2 + b * x + c = 0) ∧ (∀(a, b, c)∈set les. a * x⇧2 + b * x + c < 0))" proof - assume "(∃(a', b', c')∈set eq. a' ≠ 0 ∧ - b'⇧2 + 4 * a' * c' ≤ 0 ∧ (∀(d, e, f)∈set eq. d * ((- b' + - 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a'))⇧2 + e * ((- b' + - 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a')) + f = 0) ∧ (∀(d, e, f)∈set les. d * ((- b' + - 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a'))⇧2 + e * ((- b' + - 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a')) + f < 0))" then obtain a' b' c' where abc_prop: "a' ≠ 0 ∧ - b'⇧2 + 4 * a' * c' ≤ 0 ∧ (a', b', c')∈set eq ∧ (∀(d, e, f)∈set eq. d * ((- b' + - 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a'))⇧2 + e * ((- b' + - 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a')) + f = 0) ∧ (∀(d, e, f)∈set les. d * ((- b' + - 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a'))⇧2 + e * ((- b' + - 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a')) + f < 0)" by auto let ?x = "(- b' + - 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a')" have anonz: "a' ≠ 0" using abc_prop by auto then have "∃(q::real). q = ?x" by auto then obtain q where q_prop: "q = ?x" by auto have "(∀(d, e, f)∈set eq. d * (?x)⇧2 + e * (?x) + f = 0) ∧ (∀(d, e, f)∈set les. d * (?x)⇧2 + e * (?x) + f < 0)" using abc_prop by auto then have "(∀(d, e, f)∈set eq. d * q⇧2 + e * q + f = 0) ∧ (∀(d, e, f)∈set les. d * q⇧2 + e * q + f < 0)" using q_prop by auto then show ?thesis by auto qed have h4: "((∀(d, e, f)∈set eq. d = 0 ∧ e = 0 ∧ f = 0) ∧ (∃x. ∀(a, b, c)∈set les. a * x⇧2 + b * x + c < 0)) ⟹ (∃x. (∀(a, b, c)∈set eq. a * x⇧2 + b * x + c = 0) ∧ (∀(a, b, c)∈set les. a * x⇧2 + b * x + c < 0))" proof - assume asm: "((∀(d, e, f)∈set eq. d = 0 ∧ e = 0 ∧ f = 0) ∧ (∃x. ∀(a, b, c)∈set les. a * x⇧2 + b * x + c < 0))" then have allzer: "(∀(d, e, f)∈set eq. d = 0 ∧ e = 0 ∧ f = 0)" by auto have "(∃x. ∀(a, b, c)∈set les. a * x⇧2 + b * x + c < 0)" using asm by auto then obtain x where x_prop: " ∀(a, b, c)∈set les. a * x⇧2 + b * x + c < 0" by auto then have "∀(d, e, f)∈set eq. d*x^2 + e*x + f = 0" using allzer by auto then show ?thesis using x_prop by auto qed show ?thesis using bigor h1 h2 h3 h4 by blast qed lemma eq_qe : "(∃x. ((∀(a, b, c)∈set eq. a * x⇧2 + b * x + c = 0) ∧ (∀(a, b, c)∈set les. a * x⇧2 + b * x + c < 0))) = ((∃(a', b', c')∈set eq. (a' = 0 ∧ b' ≠ 0) ∧ (∀(d, e, f)∈set eq. d * (- c' / b')⇧2 + e * (- c' / b') + f = 0) ∧ (∀(d, e, f)∈set les. d * (- c' / b')⇧2 + e * (- c' / b') + f < 0) ∨ a' ≠ 0 ∧ - b'⇧2 + 4 * a' * c' ≤ 0 ∧ ((∀(d, e, f)∈set eq. d * ((- b' + 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a'))⇧2 + e * ((- b' + 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a')) + f = 0) ∧ (∀(d, e, f)∈set les. d * ((- b' + 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a'))⇧2 + e * ((- b' + 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a')) + f < 0) ∨ (∀(d, e, f)∈set eq. d * ((- b' + - 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a'))⇧2 + e * ((- b' + - 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a')) + f = 0) ∧ (∀(d, e, f)∈set les. d * ((- b' + - 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a'))⇧2 + e * ((- b' + - 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a')) + f < 0))) ∨ (∀(d, e, f)∈set eq. d = 0 ∧ e = 0 ∧ f = 0) ∧ (∃x. ∀(a, b, c)∈set les. a * x⇧2 + b * x + c < 0))" proof - have h1: "(∃x. (∀(a, b, c)∈set eq. a * x⇧2 + b * x + c = 0) ∧ (∀(a, b, c)∈set les. a * x⇧2 + b * x + c < 0)) ⟶ ((∃(a', b', c')∈set eq. (a' = 0 ∧ b' ≠ 0) ∧ (∀(d, e, f)∈set eq. d * (- c' / b')⇧2 + e * (- c' / b') + f = 0) ∧ (∀(d, e, f)∈set les. d * (- c' / b')⇧2 + e * (- c' / b') + f < 0) ∨ a' ≠ 0 ∧ - b'⇧2 + 4 * a' * c' ≤ 0 ∧ ((∀(d, e, f)∈set eq. d * ((- b' + 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a'))⇧2 + e * ((- b' + 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a')) + f = 0) ∧ (∀(d, e, f)∈set les. d * ((- b' + 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a'))⇧2 + e * ((- b' + 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a')) + f < 0) ∨ (∀(d, e, f)∈set eq. d * ((- b' + - 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a'))⇧2 + e * ((- b' + - 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a')) + f = 0) ∧ (∀(d, e, f)∈set les. d * ((- b' + - 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a'))⇧2 + e * ((- b' + - 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a')) + f < 0))) ∨ (∀(d, e, f)∈set eq. d = 0 ∧ e = 0 ∧ f = 0) ∧ (∃x. ∀(a, b, c)∈set les. a * x⇧2 + b * x + c < 0))" using eq_qe_forwards by auto have h2: "((∃(a', b', c')∈set eq. (a' = 0 ∧ b' ≠ 0) ∧ (∀(d, e, f)∈set eq. d * (- c' / b')⇧2 + e * (- c' / b') + f = 0) ∧ (∀(d, e, f)∈set les. d * (- c' / b')⇧2 + e * (- c' / b') + f < 0) ∨ a' ≠ 0 ∧ - b'⇧2 + 4 * a' * c' ≤ 0 ∧ ((∀(d, e, f)∈set eq. d * ((- b' + 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a'))⇧2 + e * ((- b' + 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a')) + f = 0) ∧ (∀(d, e, f)∈set les. d * ((- b' + 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a'))⇧2 + e * ((- b' + 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a')) + f < 0) ∨ (∀(d, e, f)∈set eq. d * ((- b' + - 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a'))⇧2 + e * ((- b' + - 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a')) + f = 0) ∧ (∀(d, e, f)∈set les. d * ((- b' + - 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a'))⇧2 + e * ((- b' + - 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a')) + f < 0))) ∨ (∀(d, e, f)∈set eq. d = 0 ∧ e = 0 ∧ f = 0) ∧ (∃x. ∀(a, b, c)∈set les. a * x⇧2 + b * x + c < 0)) ⟶ (∃x. (∀(a, b, c)∈set eq. a * x⇧2 + b * x + c = 0) ∧ (∀(a, b, c)∈set les. a * x⇧2 + b * x + c < 0))" using eq_qe_backwards by auto have h3: "(∃x. (∀(a, b, c)∈set eq. a * x⇧2 + b * x + c = 0) ∧ (∀(a, b, c)∈set les. a * x⇧2 + b * x + c < 0)) ⟷ ((∃(a', b', c')∈set eq. (a' = 0 ∧ b' ≠ 0) ∧ (∀(d, e, f)∈set eq. d * (- c' / b')⇧2 + e * (- c' / b') + f = 0) ∧ (∀(d, e, f)∈set les. d * (- c' / b')⇧2 + e * (- c' / b') + f < 0) ∨ a' ≠ 0 ∧ - b'⇧2 + 4 * a' * c' ≤ 0 ∧ ((∀(d, e, f)∈set eq. d * ((- b' + 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a'))⇧2 + e * ((- b' + 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a')) + f = 0) ∧ (∀(d, e, f)∈set les. d * ((- b' + 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a'))⇧2 + e * ((- b' + 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a')) + f < 0) ∨ (∀(d, e, f)∈set eq. d * ((- b' + - 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a'))⇧2 + e * ((- b' + - 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a')) + f = 0) ∧ (∀(d, e, f)∈set les. d * ((- b' + - 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a'))⇧2 + e * ((- b' + - 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a')) + f < 0))) ∨ (∀(d, e, f)∈set eq. d = 0 ∧ e = 0 ∧ f = 0) ∧ (∃x. ∀(a, b, c)∈set les. a * x⇧2 + b * x + c < 0))" using h1 h2 by smt then show ?thesis by (auto) qed subsubsection "The qe\\_forwards lemma" lemma qe_forwards_helper_gen: fixes r:: "real" assumes f8: "¬(∃((a'::real), (b'::real), (c'::real))∈set c. ((a'≠ 0 ∨ b'≠ 0) ∧ a'*r^2 + b'*r + c' = 0) ∧ ((∀(d, e, f)∈set a. d * r⇧2 + e * r + f = 0) ∧ (∀(d, e, f)∈set b. d * r^2 + e * r + f < 0) ∧ (∀(d, e, f)∈set c. d * r^2 + e * r + f ≤ 0) ∧ (∀(d, e, f)∈set d. d * r^2 + e * r + f ≠ 0)))" assumes alleqset: "∀x. (∀(d, e, f)∈set a. d * x^2 + e * x + f = 0)" assumes f5: "¬(∃(a', b', c')∈set b. (a' = 0 ∧ b' ≠ 0) ∧ (∀(d, e, f)∈set a. ∃y'>- c' / b'. ∀x∈{- c' / b'<..y'}. d * x⇧2 + e * x + f = 0) ∧ (∀(d, e, f)∈set b. ∃y'>- c' / b'. ∀x∈{- c' / b'<..y'}. d * x⇧2 + e * x + f < 0) ∧ (∀(d, e, f)∈set c. ∃y'>- c' / b'. ∀x∈{- c' / b'<..y'}. d * x⇧2 + e * x + f ≤ 0) ∧ (∀(d, e, f)∈set d. ∃y'>- c' / b'. ∀x∈{- c' / b'<..y'}. d * x⇧2 + e * x + f ≠ 0))" assumes f6: "¬ (∃(a', b', c')∈set b. a' ≠ 0 ∧ - b'⇧2 + 4 * a' * c' ≤ 0 ∧ ((∀(d, e, f)∈set a. ∃y'>(- b' + 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a'). ∀x∈{(- b' + 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a')<..y'}. d * x⇧2 + e * x + f = 0) ∧ (∀(d, e, f)∈set b. ∃y'>(- b' + 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a'). ∀x∈{(- b' + 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a')<..y'}. d * x⇧2 + e * x + f < 0) ∧ (∀(d, e, f)∈set c. ∃y'>(- b' + 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a'). ∀x∈{(- b' + 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a')<..y'}. d * x⇧2 + e * x + f ≤ 0) ∧ (∀(d, e, f)∈set d. ∃y'>(- b' + 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a'). ∀x∈{(- b' + 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a')<..y'}. d * x⇧2 + e * x + f ≠ 0)))" assumes f7: "¬ (∃(a', b', c')∈set b. a' ≠ 0 ∧ - b'⇧2 + 4 * a' * c' ≤ 0 ∧ (∀(d, e, f)∈set a. ∃y'>(- b' + - 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a'). ∀x∈{(- b' + - 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a')<..y'}. d * x⇧2 + e * x + f = 0) ∧ (∀(d, e, f)∈set b. ∃y'>(- b' + - 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a'). ∀x∈{(- b' + - 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a')<..y'}. d * x⇧2 + e * x + f < 0) ∧ (∀(d, e, f)∈set c. ∃y'>(- b' + - 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a'). ∀x∈{(- b' + - 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a')<..y'}. d * x⇧2 + e * x + f ≤ 0) ∧ (∀(d, e, f)∈set d. ∃y'>(- b' + - 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a'). ∀x∈{(- b' + - 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a')<..y'}. d * x⇧2 + e * x + f ≠ 0))" assumes f10: "¬(∃(a', b', c')∈set d. (a' = 0 ∧ b' ≠ 0) ∧ (∀(d, e, f)∈set a. ∃y'>- c' / b'. ∀x∈{- c' / b'<..y'}. d * x⇧2 + e * x + f = 0) ∧ (∀(d, e, f)∈set b. ∃y'>- c' / b'. ∀x∈{- c' / b'<..y'}. d * x⇧2 + e * x + f < 0) ∧ (∀(d, e, f)∈set c. ∃y'>- c' / b'. ∀x∈{- c' / b'<..y'}. d * x⇧2 + e * x + f ≤ 0) ∧ (∀(d, e, f)∈set d. ∃y'>- c' / b'. ∀x∈{- c' / b'<..y'}. d * x⇧2 + e * x + f ≠ 0))" assumes f11: "¬(∃(a', b', c')∈set d. a' ≠ 0 ∧ - b'⇧2 + 4 * a' * c' ≤ 0 ∧ ((∀(d, e, f)∈set a. ∃y'>(- b' + 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a'). ∀x∈{(- b' + 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a')<..y'}. d * x⇧2 + e * x + f = 0) ∧ (∀(d, e, f)∈set b. ∃y'>(- b' + 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a'). ∀x∈{(- b' + 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a')<..y'}. d * x⇧2 + e * x + f < 0) ∧ (∀(d, e, f)∈set c. ∃y'>(- b' + 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a'). ∀x∈{(- b' + 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a')<..y'}. d * x⇧2 + e * x + f ≤ 0) ∧ (∀(d, e, f)∈set d. ∃y'>(- b' + 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a'). ∀x∈{(- b' + 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a')<..y'}. d * x⇧2 + e * x + f ≠ 0)))" assumes f12: "¬(∃(a', b', c')∈set d. a' ≠ 0 ∧ - b'⇧2 + 4 * a' * c' ≤ 0 ∧ (∀(d, e, f)∈set a. ∃y'>(- b' + - 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a'). ∀x∈{(- b' + - 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a')<..y'}. d * x⇧2 + e * x + f = 0) ∧ (∀(d, e, f)∈set b. ∃y'>(- b' + - 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a'). ∀x∈{(- b' + - 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a')<..y'}. d * x⇧2 + e * x + f < 0) ∧ (∀(d, e, f)∈set c. ∃y'>(- b' + - 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a'). ∀x∈{(- b' + - 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a')<..y'}. d * x⇧2 + e * x + f ≤ 0) ∧ (∀(d, e, f)∈set d. ∃y'>(- b' + - 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a'). ∀x∈{(- b' + - 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a')<..y'}. d * x⇧2 + e * x + f ≠ 0))" shows "¬(∃(a', b', c')∈set c. ((a'≠ 0 ∨ b'≠ 0) ∧ a'*r^2 + b'*r + c' = 0) ∧ (∀(d, e, f)∈set a. ∃y'>r. ∀x∈{r<..y'}. d * x⇧2 + e * x + f = 0) ∧ (∀(d, e, f)∈set b. ∃y'>r. ∀x∈{r<..y'}. d * x⇧2 + e * x + f < 0) ∧ (∀(d, e, f)∈set c. ∃y'>r. ∀x∈{r<..y'}. d * x⇧2 + e * x + f ≤ 0) ∧ (∀(d, e, f)∈set d. ∃y'>r. ∀x∈{r<..y'}. d * x⇧2 + e * x + f ≠ 0))" proof - have "(∃(a', b', c')∈set c. ((a'≠ 0 ∨ b'≠ 0) ∧ a'*r^2 + b'*r + c' = 0) ∧ (∀(d, e, f)∈set a. ∃y'>r. ∀x∈{r<..y'}. d * x⇧2 + e * x + f = 0) ∧ (∀(d, e, f)∈set b. ∃y'>r. ∀x∈{r<..y'}. d * x⇧2 + e * x + f < 0) ∧ (∀(d, e, f)∈set c. ∃y'>r. ∀x∈{r<..y'}. d * x⇧2 + e * x + f ≤ 0) ∧ (∀(d, e, f)∈set d. ∃y'>r. ∀x∈{r<..y'}. d * x⇧2 + e * x + f ≠ 0)) ⟹ False" proof - assume "(∃(a', b', c')∈set c. ((a'≠ 0 ∨ b'≠ 0) ∧ a'*r^2 + b'*r + c' = 0) ∧ (∀(d, e, f)∈set a. ∃y'>r. ∀x∈{r<..y'}. d * x⇧2 + e * x + f = 0) ∧ (∀(d, e, f)∈set b. ∃y'>r. ∀x∈{r<..y'}. d * x⇧2 + e * x + f < 0) ∧ (∀(d, e, f)∈set c. ∃y'>r. ∀x∈{r<..y'}. d * x⇧2 + e * x + f ≤ 0) ∧ (∀(d, e, f)∈set d. ∃y'>r. ∀x∈{r<..y'}. d * x⇧2 + e * x + f ≠ 0))" then obtain a' b' c' where abc_prop: "(a', b', c')∈set c ∧ ((a'≠ 0 ∨ b'≠ 0) ∧ a'*r^2 + b'*r + c' = 0) ∧ (∀(d, e, f)∈set a. ∃y'>r. ∀x∈{r<..y'}. d * x⇧2 + e * x + f = 0) ∧ (∀(d, e, f)∈set b. ∃y'>r. ∀x∈{r<..y'}. d * x⇧2 + e * x + f < 0) ∧ (∀(d, e, f)∈set c. ∃y'>r. ∀x∈{r<..y'}. d * x⇧2 + e * x + f ≤ 0) ∧ (∀(d, e, f)∈set d. ∃y'>r. ∀x∈{r<..y'}. d * x⇧2 + e * x + f ≠ 0)" by auto have h1: "(∀(d, e, f)∈set a. d * r^2 + e * r + f = 0)" using alleqset by blast have c_prop: "(∀(d, e, f)∈set c. ∃y'>r. ∀x∈{r<..y'}. d * x⇧2 + e * x + f ≤ 0)" using abc_prop by auto have h2: "(∀(d, e, f)∈set c. d *r^2 + e * r + f ≤ 0)" proof - have c1: "∃ (d, e, f) ∈ set c. d * (r)⇧2 + e * (r) + f > 0 ⟹ False" proof - assume "∃ (d, e, f) ∈ set c. d * (r)⇧2 + e * (r) + f > 0" then obtain d e f where def_prop: "(d, e, f) ∈ set c ∧ d * (r)⇧2 + e * r + f > 0" by auto have "∃y'>r. ∀x∈{r<..y'}. d * x⇧2 + e * x + f ≤ 0" using def_prop c_prop by auto then obtain y' where y_prop: " y' >r ∧ (∀x∈{r<..y'}. d * x⇧2 + e * x + f ≤ 0)" by auto have "∃x∈{r<..y'}. d*x^2 + e*x + f > 0" using def_prop continuity_lem_gt0_expanded[of "r" y' d e f] using y_prop by linarith then show "False" using y_prop by auto qed then show ?thesis by fastforce qed have b_prop: "(∀(d, e, f)∈set b. ∃y'>r. ∀x∈{r<..y'}. d * x⇧2 + e * x + f < 0)" using abc_prop by auto have h3: "(∀(d, e, f)∈set b. d * r⇧2 + e * r + f < 0)" proof - have c1: "∃ (d, e, f) ∈ set b. d * r⇧2 + e * r + f > 0 ⟹ False" proof - assume "∃ (d, e, f) ∈ set b. d * r⇧2 + e * r + f > 0" then obtain d e f where def_prop: "(d, e, f) ∈ set b ∧ d * r⇧2 + e * r + f > 0" by auto then have "∃y'>r. ∀x∈{r<..y'}. d * x⇧2 + e * x + f < 0" using b_prop by auto then obtain y' where y_prop: " y' >r ∧ (∀x∈{r<..y'}. d * x⇧2 + e * x + f < 0)" by auto then have "∃k. k > r ∧ k < y' ∧ d * k^2 + e * k + f < 0" using dense by (meson dense greaterThanAtMost_iff less_eq_real_def) then obtain k where k_prop: "k > r ∧ k < y' ∧ d * k^2 + e * k + f < 0" by auto then have "¬(∃x>r. x < y' ∧ d * x⇧2 + e * x + f = 0)" using y_prop by force then show "False" using k_prop def_prop y_prop poly_IVT_neg[of "r" "k" "[:f, e, d:]"] poly_IVT_pos[of "-c'/b'" "k" "[:f, e, d:]"] by (smt quadratic_poly_eval) qed have c2: "∃ (d, e, f) ∈ set b. d * r⇧2 + e * r + f = 0 ⟹ False" proof - assume "∃ (d, e, f) ∈ set b. d * r⇧2 + e * r + f = 0" then obtain d' e f where def_prop: "(d', e, f) ∈ set b ∧ d' * r⇧2 + e * r + f = 0" by auto then have same: "(d' = 0 ∧ e ≠ 0) ⟹ (-f/e = r)" proof - assume asm: "(d' = 0 ∧ e ≠ 0)" then have " e * r + f = 0" using def_prop by auto then show "-f/e = r" using asm by (metis (no_types) add.commute diff_0 divide_minus_left minus_add_cancel nonzero_mult_div_cancel_left uminus_add_conv_diff) qed let ?r = "-f/e" have "(d' = 0 ∧ e ≠ 0) ⟹ ((d', e, f) ∈ set b ∧ ((∀(d, e, f)∈set a. ∃y'>?r. ∀x∈{?r<..y'}. d * x⇧2 + e * x + f = 0) ∧ (∀(d, e, f)∈set b. ∃y'>?r. ∀x∈{?r<..y'}. d * x⇧2 + e * x + f < 0) ∧ (∀(d, e, f)∈set c. ∃y'>?r. ∀x∈{?r<..y'}. d * x⇧2 + e * x + f ≤ 0) ∧ (∀(d, e, f)∈set d. ∃y'>?r. ∀x∈{?r<..y'}. d * x⇧2 + e * x + f ≠ 0)))" using same def_prop abc_prop by auto then have "(d' = 0 ∧ e ≠ 0) ⟹ (∃(a', b', c')∈set b. (a' = 0 ∧ b' ≠ 0) ∧ (∀(d, e, f)∈set a. ∃y'>- c' / b'. ∀x∈{- c' / b'<..y'}. d * x⇧2 + e * x + f = 0) ∧ (∀(d, e, f)∈set b. ∃y'>- c' / b'. ∀x∈{- c' / b'<..y'}. d * x⇧2 + e * x + f < 0) ∧ (∀(d, e, f)∈set c. ∃y'>- c' / b'. ∀x∈{- c' / b'<..y'}. d * x⇧2 + e * x + f ≤ 0) ∧ (∀(d, e, f)∈set d. ∃y'>- c' / b'. ∀x∈{- c' / b'<..y'}. d * x⇧2 + e * x + f ≠ 0))" by auto then have f1: "(d' = 0 ∧ e ≠ 0) ⟹ False" using f5 by auto have f2: "(d' = 0 ∧ e = 0 ∧ f = 0) ⟹ False" proof - assume "(d' = 0 ∧ e = 0 ∧ f = 0)" then have allzer: "∀x. d'*x^2 + e*x + f = 0" by auto have "∃y'>r. ∀x∈{r<..y'}. d' * x⇧2 + e * x + f < 0" using b_prop def_prop by auto then obtain y' where y_prop: " y' >r ∧ (∀x∈{r<..y'}. d' * x⇧2 + e * x + f < 0)" by auto then have "∃k. k > r ∧ k < y' ∧ d' * k^2 + e * k + f < 0" using dense by (meson dense greaterThanAtMost_iff less_eq_real_def) then show "False" using allzer by auto qed have f3: "d' ≠ 0 ⟹ False" proof - assume dnonz: "d' ≠ 0" have discr: " - e⇧2 + 4 * d' * f ≤ 0" using def_prop discriminant_negative[of d' e f] unfolding discrim_def using def_prop by fastforce then have two_cases: "r = (- e + - 1 * sqrt (e^2 - 4 * d' * f)) / (2 * d') ∨ r = (- e + 1 * sqrt (e⇧2 - 4 * d' * f)) / (2 * d')" using def_prop dnonz discriminant_nonneg[of d' e f] unfolding discrim_def by fastforce have some_props: "((d', e, f) ∈ set b ∧ d' ≠ 0 ∧ - e⇧2 + 4 * d' * f ≤ 0)" using dnonz def_prop discr by auto let ?r1 = "(- e + - 1 * sqrt (e^2 - 4 * d' * f)) / (2 * d')" let ?r2 = "(- e + 1 * sqrt (e^2 - 4 * d' * f)) / (2 * d')" have cf1: "r = (- e + - 1 * sqrt (e^2 - 4 * d' * f)) / (2 * d') ⟹ False" proof - assume "r = (- e + - 1 * sqrt (e^2 - 4 * d' * f)) / (2 * d')" then have "(d', e, f) ∈ set b ∧ d' ≠ 0 ∧ - e⇧2 + 4 * d' * f ≤ 0 ∧ ((∀(d, e, f)∈set a. ∃y'>?r1. ∀x∈{?r1<..y'}. d * x⇧2 + e * x + f = 0) ∧ (∀(d, e, f)∈set b. ∃y'>?r1. ∀x∈{?r1<..y'}. d * x⇧2 + e * x + f < 0) ∧ (∀(d, e, f)∈set c. ∃y'>?r1. ∀x∈{?r1<..y'}. d * x⇧2 + e * x + f ≤ 0) ∧ (∀(d, e, f)∈set d. ∃y'>?r1. ∀x∈{?r1<..y'}. d * x⇧2 + e * x + f ≠ 0))" using abc_prop some_props by auto then show "False" using f7 by auto qed have cf2: "r = (- e + 1 * sqrt (e^2 - 4 * d' * f)) / (2 * d') ⟹ False" proof - assume "r = (- e + 1 * sqrt (e^2 - 4 * d' * f)) / (2 * d')" then have "(d', e, f) ∈ set b ∧ d' ≠ 0 ∧ - e⇧2 + 4 * d' * f ≤ 0 ∧ ((∀(d, e, f)∈set a. ∃y'>?r2. ∀x∈{?r2<..y'}. d * x⇧2 + e * x + f = 0) ∧ (∀(d, e, f)∈set b. ∃y'>?r2. ∀x∈{?r2<..y'}. d * x⇧2 + e * x + f < 0) ∧ (∀(d, e, f)∈set c. ∃y'>?r2. ∀x∈{?r2<..y'}. d * x⇧2 + e * x + f ≤ 0) ∧ (∀(d, e, f)∈set d. ∃y'>?r2. ∀x∈{?r2<..y'}. d * x⇧2 + e * x + f ≠ 0))" using abc_prop some_props by auto then show "False" using f6 by auto qed then show "False" using two_cases cf1 cf2 by auto qed (* discriminant_nonnegative *) have eo: "(d' ≠ 0) ∨ (d' = 0 ∧ e ≠ 0) ∨ (d' = 0 ∧ e = 0 ∧ f = 0)" using def_prop by auto then show "False" using f1 f2 f3 by auto qed show ?thesis using c1 c2 by fastforce qed have d_prop: "(∀(d, e, f)∈set d. ∃y'>r. ∀x∈{r<..y'}. d * x⇧2 + e * x + f ≠ 0)" using abc_prop by auto have h4: "(∀(d, e, f)∈set d. d * r⇧2 + e * r + f ≠ 0)" proof - have "(∃(d, e, f)∈set d. d * r⇧2 + e * r + f = 0) ⟹ False" proof - assume "∃ (d, e, f) ∈ set d. d * r⇧2 + e * r + f = 0" then obtain d' e f where def_prop: "(d', e, f) ∈ set d ∧ d' * r⇧2 + e * r + f = 0" by auto then have same: "(d' = 0 ∧ e ≠ 0) ⟹ (-f/e = r)" proof - assume asm: "(d' = 0 ∧ e ≠ 0)" then have " e * r + f = 0" using def_prop by auto then show "-f/e = r" using asm by (metis (no_types) add.commute diff_0 divide_minus_left minus_add_cancel nonzero_mult_div_cancel_left uminus_add_conv_diff) qed let ?r = "-f/e" have "(d' = 0 ∧ e ≠ 0) ⟹ ((d', e, f) ∈ set d ∧ ((∀(d, e, f)∈set a. ∃y'>?r. ∀x∈{?r<..y'}. d * x⇧2 + e * x + f = 0) ∧ (∀(d, e, f)∈set b. ∃y'>?r. ∀x∈{?r<..y'}. d * x⇧2 + e * x + f < 0) ∧ (∀(d, e, f)∈set c. ∃y'>?r. ∀x∈{?r<..y'}. d * x⇧2 + e * x + f ≤ 0) ∧ (∀(d, e, f)∈set d. ∃y'>?r. ∀x∈{?r<..y'}. d * x⇧2 + e * x + f ≠ 0)))" using same def_prop abc_prop by auto then have "(d' = 0 ∧ e ≠ 0) ⟹ (∃(a', b', c')∈set d. (a' = 0 ∧ b' ≠ 0) ∧ (∀(d, e, f)∈set a. ∃y'> -c'/b'. ∀x∈{ -c'/b'<..y'}. d * x⇧2 + e * x + f = 0) ∧ (∀(d, e, f)∈set b. ∃y'> -c'/b'. ∀x∈{ -c'/b'<..y'}. d * x⇧2 + e * x + f < 0) ∧ (∀(d, e, f)∈set c. ∃y'> -c'/b'. ∀x∈{ -c'/b'<..y'}. d * x⇧2 + e * x + f ≤ 0) ∧ (∀(d, e, f)∈set d. ∃y'> -c'/b'. ∀x∈{ -c'/b'<..y'}. d * x⇧2 + e * x + f ≠ 0))" by auto then have f1: "(d' = 0 ∧ e ≠ 0) ⟹ False" using f10 by auto have f2: "(d' = 0 ∧ e = 0 ∧ f = 0) ⟹ False" proof - assume "(d' = 0 ∧ e = 0 ∧ f = 0)" then have allzer: "∀x. d'*x^2 + e*x + f = 0" by auto have "∃y'> r. ∀x∈{ r<..y'}. d' * x⇧2 + e * x + f ≠ 0" using d_prop def_prop by auto then obtain y' where y_prop: " y' >r ∧ (∀x∈{r<..y'}. d' * x⇧2 + e * x + f ≠ 0)" by auto then have "∃k. k > r ∧ k < y' ∧ d' * k^2 + e * k + f ≠ 0" using dense by (meson dense greaterThanAtMost_iff less_eq_real_def) then show "False" using allzer by auto qed have f3: "d' ≠ 0 ⟹ False" proof - assume dnonz: "d' ≠ 0" have discr: " - e⇧2 + 4 * d' * f ≤ 0" using def_prop discriminant_negative[of d' e f] unfolding discrim_def by fastforce then have two_cases: "r = (- e + - 1 * sqrt (e^2 - 4 * d' * f)) / (2 * d') ∨ r = (- e + 1 * sqrt (e⇧2 - 4 * d' * f)) / (2 * d')" using def_prop dnonz discriminant_nonneg[of d' e f] unfolding discrim_def by fastforce have some_props: "((d', e, f) ∈ set d ∧ d' ≠ 0 ∧ - e⇧2 + 4 * d' * f ≤ 0)" using dnonz def_prop discr by auto let ?r1 = "(- e + - 1 * sqrt (e^2 - 4 * d' * f)) / (2 * d')" let ?r2 = "(- e + 1 * sqrt (e^2 - 4 * d' * f)) / (2 * d')" have cf1: "r = (- e + - 1 * sqrt (e^2 - 4 * d' * f)) / (2 * d') ⟹ False" proof - assume "r = (- e + - 1 * sqrt (e^2 - 4 * d' * f)) / (2 * d')" then have "(d', e, f) ∈ set d ∧ d' ≠ 0 ∧ - e⇧2 + 4 * d' * f ≤ 0 ∧ ((∀(d, e, f)∈set a. ∃y'>?r1. ∀x∈{?r1<..y'}. d * x⇧2 + e * x + f = 0) ∧ (∀(d, e, f)∈set b. ∃y'>?r1. ∀x∈{?r1<..y'}. d * x⇧2 + e * x + f < 0) ∧ (∀(d, e, f)∈set c. ∃y'>?r1. ∀x∈{?r1<..y'}. d * x⇧2 + e * x + f ≤ 0) ∧ (∀(d, e, f)∈set d. ∃y'>?r1. ∀x∈{?r1<..y'}. d * x⇧2 + e * x + f ≠ 0))" using abc_prop some_props by auto then show "False" using f12 by auto qed have cf2: "r = (- e + 1 * sqrt (e^2 - 4 * d' * f)) / (2 * d') ⟹ False" proof - assume "r = (- e + 1 * sqrt (e^2 - 4 * d' * f)) / (2 * d')" then have "(d', e, f) ∈ set d ∧ d' ≠ 0 ∧ - e⇧2 + 4 * d' * f ≤ 0 ∧ ((∀(d, e, f)∈set a. ∃y'>?r2. ∀x∈{?r2<..y'}. d * x⇧2 + e * x + f = 0) ∧ (∀(d, e, f)∈set b. ∃y'>?r2. ∀x∈{?r2<..y'}. d * x⇧2 + e * x + f < 0) ∧ (∀(d, e, f)∈set c. ∃y'>?r2. ∀x∈{?r2<..y'}. d * x⇧2 + e * x + f ≤ 0) ∧ (∀(d, e, f)∈set d. ∃y'>?r2. ∀x∈{?r2<..y'}. d * x⇧2 + e * x + f ≠ 0))" using abc_prop some_props by auto then show "False" using f11 by auto qed then show "False" using two_cases cf1 cf2 by auto qed (* discriminant_nonnegative *) have eo: "(d' ≠ 0) ∨ (d' = 0 ∧ e ≠ 0) ∨ (d' = 0 ∧ e = 0 ∧ f = 0)" using def_prop by auto then show "False" using f1 f2 f3 by auto qed then show ?thesis by auto qed have "(∃(a', b', c')∈set c. ((a'≠ 0 ∨ b'≠ 0) ∧ a'*r^2 + b'*r + c' = 0) ∧ (∀(d, e, f)∈set a. d * r⇧2 + e * r + f = 0) ∧ (∀(d, e, f)∈set b. d * r⇧2 + e * r + f < 0) ∧ (∀(d, e, f)∈set c. d * r⇧2 + e * r + f ≤ 0) ∧ (∀(d, e, f)∈set d. d * r⇧2 + e * r + f ≠ 0))" using h1 h2 h3 h4 abc_prop by auto then show "False" using f8 by auto qed then show ?thesis by auto qed lemma qe_forwards_helper_lin: assumes alleqset: "∀x. (∀(d, e, f)∈set a. d * x^2 + e * x + f = 0)" assumes f5: "¬(∃(a', b', c')∈set b. (a' = 0 ∧ b' ≠ 0) ∧ (∀(d, e, f)∈set a. ∃y'>- c' / b'. ∀x∈{- c' / b'<..y'}. d * x⇧2 + e * x + f = 0) ∧ (∀(d, e, f)∈set b. ∃y'>- c' / b'. ∀x∈{- c' / b'<..y'}. d * x⇧2 + e * x + f < 0) ∧ (∀(d, e, f)∈set c. ∃y'>- c' / b'. ∀x∈{- c' / b'<..y'}. d * x⇧2 + e * x + f ≤ 0) ∧ (∀(d, e, f)∈set d. ∃y'>- c' / b'. ∀x∈{- c' / b'<..y'}. d * x⇧2 + e * x + f ≠ 0))" assumes f6: "¬ (∃(a', b', c')∈set b. a' ≠ 0 ∧ - b'⇧2 + 4 * a' * c' ≤ 0 ∧ ((∀(d, e, f)∈set a. ∃y'>(- b' + 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a'). ∀x∈{(- b' + 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a')<..y'}. d * x⇧2 + e * x + f = 0) ∧ (∀(d, e, f)∈set b. ∃y'>(- b' + 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a'). ∀x∈{(- b' + 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a')<..y'}. d * x⇧2 + e * x + f < 0) ∧ (∀(d, e, f)∈set c. ∃y'>(- b' + 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a'). ∀x∈{(- b' + 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a')<..y'}. d * x⇧2 + e * x + f ≤ 0) ∧ (∀(d, e, f)∈set d. ∃y'>(- b' + 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a'). ∀x∈{(- b' + 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a')<..y'}. d * x⇧2 + e * x + f ≠ 0)))" assumes f7: "¬ (∃(a', b', c')∈set b. a' ≠ 0 ∧ - b'⇧2 + 4 * a' * c' ≤ 0 ∧ (∀(d, e, f)∈set a. ∃y'>(- b' + - 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a'). ∀x∈{(- b' + - 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a')<..y'}. d * x⇧2 + e * x + f = 0) ∧ (∀(d, e, f)∈set b. ∃y'>(- b' + - 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a'). ∀x∈{(- b' + - 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a')<..y'}. d * x⇧2 + e * x + f < 0) ∧ (∀(d, e, f)∈set c. ∃y'>(- b' + - 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a'). ∀x∈{(- b' + - 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a')<..y'}. d * x⇧2 + e * x + f ≤ 0) ∧ (∀(d, e, f)∈set d. ∃y'>(- b' + - 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a'). ∀x∈{(- b' + - 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a')<..y'}. d * x⇧2 + e * x + f ≠ 0))" assumes f8: "¬(∃(a', b', c')∈set c. (a' = 0 ∧ b' ≠ 0) ∧ (∀(d, e, f)∈set a. d * (- c' / b')⇧2 + e * (- c' / b') + f = 0) ∧ (∀(d, e, f)∈set b. d * (- c' / b')⇧2 + e * (- c' / b') + f < 0) ∧ (∀(d, e, f)∈set c. d * (- c' / b')⇧2 + e * (- c' / b') + f ≤ 0) ∧ (∀(d, e, f)∈set d. d * (- c' / b')⇧2 + e * (- c' / b') + f ≠ 0))" assumes f10: "¬(∃(a', b', c')∈set d. (a' = 0 ∧ b' ≠ 0) ∧ (∀(d, e, f)∈set a. ∃y'>- c' / b'. ∀x∈{- c' / b'<..y'}. d * x⇧2 + e * x + f = 0) ∧ (∀(d, e, f)∈set b. ∃y'>- c' / b'. ∀x∈{- c' / b'<..y'}. d * x⇧2 + e * x + f < 0) ∧ (∀(d, e, f)∈set c. ∃y'>- c' / b'. ∀x∈{- c' / b'<..y'}. d * x⇧2 + e * x + f ≤ 0) ∧ (∀(d, e, f)∈set d. ∃y'>- c' / b'. ∀x∈{- c' / b'<..y'}. d * x⇧2 + e * x + f ≠ 0))" assumes f11: "¬(∃(a', b', c')∈set d. a' ≠ 0 ∧ - b'⇧2 + 4 * a' * c' ≤ 0 ∧ ((∀(d, e, f)∈set a. ∃y'>(- b' + 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a'). ∀x∈{(- b' + 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a')<..y'}. d * x⇧2 + e * x + f = 0) ∧ (∀(d, e, f)∈set b. ∃y'>(- b' + 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a'). ∀x∈{(- b' + 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a')<..y'}. d * x⇧2 + e * x + f < 0) ∧ (∀(d, e, f)∈set c. ∃y'>(- b' + 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a'). ∀x∈{(- b' + 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a')<..y'}. d * x⇧2 + e * x + f ≤ 0) ∧ (∀(d, e, f)∈set d. ∃y'>(- b' + 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a'). ∀x∈{(- b' + 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a')<..y'}. d * x⇧2 + e * x + f ≠ 0)))" assumes f12: "¬(∃(a', b', c')∈set d. a' ≠ 0 ∧ - b'⇧2 + 4 * a' * c' ≤ 0 ∧ (∀(d, e, f)∈set a. ∃y'>(- b' + - 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a'). ∀x∈{(- b' + - 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a')<..y'}. d * x⇧2 + e * x + f = 0) ∧ (∀(d, e, f)∈set b. ∃y'>(- b' + - 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a'). ∀x∈{(- b' + - 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a')<..y'}. d * x⇧2 + e * x + f < 0) ∧ (∀(d, e, f)∈set c. ∃y'>(- b' + - 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a'). ∀x∈{(- b' + - 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a')<..y'}. d * x⇧2 + e * x + f ≤ 0) ∧ (∀(d, e, f)∈set d. ∃y'>(- b' + - 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a'). ∀x∈{(- b' + - 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a')<..y'}. d * x⇧2 + e * x + f ≠ 0))" shows "¬(∃(a', b', c')∈set c. (a' = 0 ∧ b' ≠ 0) ∧ (∀(d, e, f)∈set a. ∃y'>- c' / b'. ∀x∈{- c' / b'<..y'}. d * x⇧2 + e * x + f = 0) ∧ (∀(d, e, f)∈set b. ∃y'>- c' / b'. ∀x∈{- c' / b'<..y'}. d * x⇧2 + e * x + f < 0) ∧ (∀(d, e, f)∈set c. ∃y'>- c' / b'. ∀x∈{- c' / b'<..y'}. d * x⇧2 + e * x + f ≤ 0) ∧ (∀(d, e, f)∈set d. ∃y'>- c' / b'. ∀x∈{- c' / b'<..y'}. d * x⇧2 + e * x + f ≠ 0))" proof - have "(∃(a', b', c')∈set c. (a' = 0 ∧ b' ≠ 0) ∧ (∀(d, e, f)∈set a. ∃y'>- c' / b'. ∀x∈{- c' / b'<..y'}. d * x⇧2 + e * x + f = 0) ∧ (∀(d, e, f)∈set b. ∃y'>- c' / b'. ∀x∈{- c' / b'<..y'}. d * x⇧2 + e * x + f < 0) ∧ (∀(d, e, f)∈set c. ∃y'>- c' / b'. ∀x∈{- c' / b'<..y'}. d * x⇧2 + e * x + f ≤ 0) ∧ (∀(d, e, f)∈set d. ∃y'>- c' / b'. ∀x∈{- c' / b'<..y'}. d * x⇧2 + e * x + f ≠ 0)) ⟹ False" proof - assume "(∃(a', b', c')∈set c. (a' = 0 ∧ b' ≠ 0) ∧ (∀(d, e, f)∈set a. ∃y'>- c' / b'. ∀x∈{- c' / b'<..y'}. d * x⇧2 + e * x + f = 0) ∧ (∀(d, e, f)∈set b. ∃y'>- c' / b'. ∀x∈{- c' / b'<..y'}. d * x⇧2 + e * x + f < 0) ∧ (∀(d, e, f)∈set c. ∃y'>- c' / b'. ∀x∈{- c' / b'<..y'}. d * x⇧2 + e * x + f ≤ 0) ∧ (∀(d, e, f)∈set d. ∃y'>- c' / b'. ∀x∈{- c' / b'<..y'}. d * x⇧2 + e * x + f ≠ 0))" then obtain a' b' c' where abc_prop: "(a', b', c')∈set c ∧ (a' = 0 ∧ b' ≠ 0) ∧ (∀(d, e, f)∈set a. ∃y'>- c' / b'. ∀x∈{- c' / b'<..y'}. d * x⇧2 + e * x + f = 0) ∧ (∀(d, e, f)∈set b. ∃y'>- c' / b'. ∀x∈{- c' / b'<..y'}. d * x⇧2 + e * x + f < 0) ∧ (∀(d, e, f)∈set c. ∃y'>- c' / b'. ∀x∈{- c' / b'<..y'}. d * x⇧2 + e * x + f ≤ 0) ∧ (∀(d, e, f)∈set d. ∃y'>- c' / b'. ∀x∈{- c' / b'<..y'}. d * x⇧2 + e * x + f ≠ 0)" by auto then have bnonz: "b'≠0" by auto have h1: "(∀(d, e, f)∈set a. d * (- c' / b')⇧2 + e * (- c' / b') + f = 0)" using bnonz alleqset by blast have c_prop: "(∀(d, e, f)∈set c. ∃y'>- c' / b'. ∀x∈{- c' / b'<..y'}. d * x⇧2 + e * x + f ≤ 0)" using abc_prop by auto have h2: "(∀(d, e, f)∈set c. d * (- c' / b')⇧2 + e * (- c' / b') + f ≤ 0)" proof - have c1: "∃ (d, e, f) ∈ set c. d * (- c' / b')⇧2 + e * (- c' / b') + f > 0 ⟹ False" proof - assume "∃ (d, e, f) ∈ set c. d * (- c' / b')⇧2 + e * (- c' / b') + f > 0" then obtain d e f where def_prop: "(d, e, f) ∈ set c ∧ d * (- c' / b')⇧2 + e * (- c' / b') + f > 0" by auto have "∃y'>- c' / b'. ∀x∈{- c' / b'<..y'}. d * x⇧2 + e * x + f ≤ 0" using def_prop c_prop by auto then obtain y' where y_prop: " y' >- c' / b' ∧ (∀x∈{- c' / b'<..y'}. d * x⇧2 + e * x + f ≤ 0)" by auto have "∃x∈{(-c'/b')<..y'}. d*x^2 + e*x + f > 0" using def_prop continuity_lem_gt0_expanded[of "(-c'/b')" y' d e f] using y_prop by linarith then show "False" using y_prop by auto qed then show ?thesis by fastforce qed have b_prop: "(∀(d, e, f)∈set b. ∃y'>- c' / b'. ∀x∈{- c' / b'<..y'}. d * x⇧2 + e * x + f < 0)" using abc_prop by auto have h3: "(∀(d, e, f)∈set b. d * (- c' / b')⇧2 + e * (- c' / b') + f < 0)" proof - have c1: "∃ (d, e, f) ∈ set b. d * (- c' / b')⇧2 + e * (- c' / b') + f > 0 ⟹ False" proof - assume "∃ (d, e, f) ∈ set b. d * (- c' / b')⇧2 + e * (- c' / b') + f > 0" then obtain d e f where def_prop: "(d, e, f) ∈ set b ∧ d * (- c' / b')⇧2 + e * (- c' / b') + f > 0" by auto then have "∃y'>- c' / b'. ∀x∈{- c' / b'<..y'}. d * x⇧2 + e * x + f < 0" using b_prop by auto then obtain y' where y_prop: " y' >- c' / b' ∧ (∀x∈{- c' / b'<..y'}. d * x⇧2 + e * x + f < 0)" by auto then have "∃k. k > -c'/b' ∧ k < y' ∧ d * k^2 + e * k + f < 0" using dense by (meson dense greaterThanAtMost_iff less_eq_real_def) then obtain k where k_prop: "k > -c'/b' ∧ k < y' ∧ d * k^2 + e * k + f < 0" by auto then have "¬(∃x>(-c'/b'). x < y' ∧ d * x⇧2 + e * x + f = 0)" using y_prop by force then show "False" using k_prop def_prop y_prop poly_IVT_neg[of "-c'/b'" "k" "[:f, e, d:]"] poly_IVT_pos[of "-c'/b'" "k" "[:f, e, d:]"] by (smt quadratic_poly_eval) qed have c2: "∃ (d, e, f) ∈ set b. d * (- c' / b')⇧2 + e * (- c' / b') + f = 0 ⟹ False" proof - assume "∃ (d, e, f) ∈ set b. d * (- c' / b')⇧2 + e * (- c' / b') + f = 0" then obtain d' e f where def_prop: "(d', e, f) ∈ set b ∧ d' * (- c' / b')⇧2 + e * (- c' / b') + f = 0" by auto then have same: "(d' = 0 ∧ e ≠ 0) ⟹ (-f/e = -c'/b')" proof - assume asm: "(d' = 0 ∧ e ≠ 0)" then have " e * (- c' / b') + f = 0" using def_prop by auto then show "-f/e = -c'/b'" using asm by auto qed let ?r = "-f/e" have "(d' = 0 ∧ e ≠ 0) ⟹ ((d', e, f) ∈ set b ∧ ((∀(d, e, f)∈set a. ∃y'>?r. ∀x∈{?r<..y'}. d * x⇧2 + e * x + f = 0) ∧ (∀(d, e, f)∈set b. ∃y'>?r. ∀x∈{?r<..y'}. d * x⇧2 + e * x + f < 0) ∧ (∀(d, e, f)∈set c. ∃y'>?r. ∀x∈{?r<..y'}. d * x⇧2 + e * x + f ≤ 0) ∧ (∀(d, e, f)∈set d. ∃y'>?r. ∀x∈{?r<..y'}. d * x⇧2 + e * x + f ≠ 0)))" using same def_prop abc_prop by auto then have "(d' = 0 ∧ e ≠ 0) ⟹ (∃(a', b', c')∈set b. (a' = 0 ∧ b' ≠ 0) ∧ (∀(d, e, f)∈set a. ∃y'>- c' / b'. ∀x∈{- c' / b'<..y'}. d * x⇧2 + e * x + f = 0) ∧ (∀(d, e, f)∈set b. ∃y'>- c' / b'. ∀x∈{- c' / b'<..y'}. d * x⇧2 + e * x + f < 0) ∧ (∀(d, e, f)∈set c. ∃y'>- c' / b'. ∀x∈{- c' / b'<..y'}. d * x⇧2 + e * x + f ≤ 0) ∧ (∀(d, e, f)∈set d. ∃y'>- c' / b'. ∀x∈{- c' / b'<..y'}. d * x⇧2 + e * x + f ≠ 0))" by auto then have f1: "(d' = 0 ∧ e ≠ 0) ⟹ False" using f5 by auto have f2: "(d' = 0 ∧ e = 0 ∧ f = 0) ⟹ False" proof - assume "(d' = 0 ∧ e = 0 ∧ f = 0)" then have allzer: "∀x. d'*x^2 + e*x + f = 0" by auto have "∃y'>- c' / b'. ∀x∈{- c' / b'<..y'}. d' * x⇧2 + e * x + f < 0" using b_prop def_prop by auto then obtain y' where y_prop: " y' >- c' / b' ∧ (∀x∈{- c' / b'<..y'}. d' * x⇧2 + e * x + f < 0)" by auto then have "∃k. k > -c'/b' ∧ k < y' ∧ d' * k^2 + e * k + f < 0" using dense by (meson dense greaterThanAtMost_iff less_eq_real_def) then show "False" using allzer by auto qed have f3: "d' ≠ 0 ⟹ False" proof - assume dnonz: "d' ≠ 0" have discr: " - e⇧2 + 4 * d' * f ≤ 0" using def_prop discriminant_negative[of d' e f] unfolding discrim_def by fastforce then have two_cases: "(- c' / b') = (- e + - 1 * sqrt (e^2 - 4 * d' * f)) / (2 * d') ∨ (- c' / b') = (- e + 1 * sqrt (e⇧2 - 4 * d' * f)) / (2 * d')" using def_prop dnonz discriminant_nonneg[of d' e f] unfolding discrim_def by fastforce have some_props: "((d', e, f) ∈ set b ∧ d' ≠ 0 ∧ - e⇧2 + 4 * d' * f ≤ 0)" using dnonz def_prop discr by auto let ?r1 = "(- e + - 1 * sqrt (e^2 - 4 * d' * f)) / (2 * d')" let ?r2 = "(- e + 1 * sqrt (e^2 - 4 * d' * f)) / (2 * d')" have cf1: "(- c' / b') = (- e + - 1 * sqrt (e^2 - 4 * d' * f)) / (2 * d') ⟹ False" proof - assume "(- c' / b') = (- e + - 1 * sqrt (e^2 - 4 * d' * f)) / (2 * d')" then have "(d', e, f) ∈ set b ∧ d' ≠ 0 ∧ - e⇧2 + 4 * d' * f ≤ 0 ∧ ((∀(d, e, f)∈set a. ∃y'>?r1. ∀x∈{?r1<..y'}. d * x⇧2 + e * x + f = 0) ∧ (∀(d, e, f)∈set b. ∃y'>?r1. ∀x∈{?r1<..y'}. d * x⇧2 + e * x + f < 0) ∧ (∀(d, e, f)∈set c. ∃y'>?r1. ∀x∈{?r1<..y'}. d * x⇧2 + e * x + f ≤ 0) ∧ (∀(d, e, f)∈set d. ∃y'>?r1. ∀x∈{?r1<..y'}. d * x⇧2 + e * x + f ≠ 0))" using abc_prop some_props by auto then show "False" using f7 by auto qed have cf2: "(- c' / b') = (- e + 1 * sqrt (e^2 - 4 * d' * f)) / (2 * d') ⟹ False" proof - assume "(- c' / b') = (- e + 1 * sqrt (e^2 - 4 * d' * f)) / (2 * d')" then have "(d', e, f) ∈ set b ∧ d' ≠ 0 ∧ - e⇧2 + 4 * d' * f ≤ 0 ∧ ((∀(d, e, f)∈set a. ∃y'>?r2. ∀x∈{?r2<..y'}. d * x⇧2 + e * x + f = 0) ∧ (∀(d, e, f)∈set b. ∃y'>?r2. ∀x∈{?r2<..y'}. d * x⇧2 + e * x + f < 0) ∧ (∀(d, e, f)∈set c. ∃y'>?r2. ∀x∈{?r2<..y'}. d * x⇧2 + e * x + f ≤ 0) ∧ (∀(d, e, f)∈set d. ∃y'>?r2. ∀x∈{?r2<..y'}. d * x⇧2 + e * x + f ≠ 0))" using abc_prop some_props by auto then show "False" using f6 by auto qed then show "False" using two_cases cf1 cf2 by auto qed (* discriminant_nonnegative *) have eo: "(d' ≠ 0) ∨ (d' = 0 ∧ e ≠ 0) ∨ (d' = 0 ∧ e = 0 ∧ f = 0)" using def_prop by auto then show "False" using f1 f2 f3 by auto qed show ?thesis using c1 c2 by fastforce qed have d_prop: "(∀(d, e, f)∈set d. ∃y'>- c' / b'. ∀x∈{- c' / b'<..y'}. d * x⇧2 + e * x + f ≠ 0)" using abc_prop by auto have h4: "(∀(d, e, f)∈set d. d * (- c' / b')⇧2 + e * (- c' / b') + f ≠ 0)" proof - have "(∃(d, e, f)∈set d. d * (- c' / b')⇧2 + e * (- c' / b') + f = 0) ⟹ False" (* begin *) proof - assume "∃ (d, e, f) ∈ set d. d * (- c' / b')⇧2 + e * (- c' / b') + f = 0" then obtain d' e f where def_prop: "(d', e, f) ∈ set d ∧ d' * (- c' / b')⇧2 + e * (- c' / b') + f = 0" by auto then have same: "(d' = 0 ∧ e ≠ 0) ⟹ (-f/e = -c'/b')" proof - assume asm: "(d' = 0 ∧ e ≠ 0)" then have " e * (- c' / b') + f = 0" using def_prop by auto then show "-f/e = -c'/b'" using asm by auto qed let ?r = "-f/e" have "(d' = 0 ∧ e ≠ 0) ⟹ ((d', e, f) ∈ set d ∧ ((∀(d, e, f)∈set a. ∃y'>?r. ∀x∈{?r<..y'}. d * x⇧2 + e * x + f = 0) ∧ (∀(d, e, f)∈set b. ∃y'>?r. ∀x∈{?r<..y'}. d * x⇧2 + e * x + f < 0) ∧ (∀(d, e, f)∈set c. ∃y'>?r. ∀x∈{?r<..y'}. d * x⇧2 + e * x + f ≤ 0) ∧ (∀(d, e, f)∈set d. ∃y'>?r. ∀x∈{?r<..y'}. d * x⇧2 + e * x + f ≠ 0)))" using same def_prop abc_prop by auto then have "(d' = 0 ∧ e ≠ 0) ⟹ (∃(a', b', c')∈set d. (a' = 0 ∧ b' ≠ 0) ∧ (∀(d, e, f)∈set a. ∃y'>- c' / b'. ∀x∈{- c' / b'<..y'}. d * x⇧2 + e * x + f = 0) ∧ (∀(d, e, f)∈set b. ∃y'>- c' / b'. ∀x∈{- c' / b'<..y'}. d * x⇧2 + e * x + f < 0) ∧ (∀(d, e, f)∈set c. ∃y'>- c' / b'. ∀x∈{- c' / b'<..y'}. d * x⇧2 + e * x + f ≤ 0) ∧ (∀(d, e, f)∈set d. ∃y'>- c' / b'. ∀x∈{- c' / b'<..y'}. d * x⇧2 + e * x + f ≠ 0))" by auto then have f1: "(d' = 0 ∧ e ≠ 0) ⟹ False" using f10 by auto have f2: "(d' = 0 ∧ e = 0 ∧ f = 0) ⟹ False" proof - assume "(d' = 0 ∧ e = 0 ∧ f = 0)" then have allzer: "∀x. d'*x^2 + e*x + f = 0" by auto have "∃y'>- c' / b'. ∀x∈{- c' / b'<..y'}. d' * x⇧2 + e * x + f ≠ 0" using d_prop def_prop by auto then obtain y' where y_prop: " y' >- c' / b' ∧ (∀x∈{- c' / b'<..y'}. d' * x⇧2 + e * x + f ≠ 0)" by auto then have "∃k. k > -c'/b' ∧ k < y' ∧ d' * k^2 + e * k + f ≠ 0" using dense by (meson dense greaterThanAtMost_iff less_eq_real_def) then show "False" using allzer by auto qed have f3: "d' ≠ 0 ⟹ False" proof - assume dnonz: "d' ≠ 0" have discr: " - e⇧2 + 4 * d' * f ≤ 0" using def_prop discriminant_negative[of d' e f] unfolding discrim_def by fastforce then have two_cases: "(- c' / b') = (- e + - 1 * sqrt (e^2 - 4 * d' * f)) / (2 * d') ∨ (- c' / b') = (- e + 1 * sqrt (e⇧2 - 4 * d' * f)) / (2 * d')" using def_prop dnonz discriminant_nonneg[of d' e f] unfolding discrim_def by fastforce have some_props: "((d', e, f) ∈ set d ∧ d' ≠ 0 ∧ - e⇧2 + 4 * d' * f ≤ 0)" using dnonz def_prop discr by auto let ?r1 = "(- e + - 1 * sqrt (e^2 - 4 * d' * f)) / (2 * d')" let ?r2 = "(- e + 1 * sqrt (e^2 - 4 * d' * f)) / (2 * d')" have cf1: "(- c' / b') = (- e + - 1 * sqrt (e^2 - 4 * d' * f)) / (2 * d') ⟹ False" proof - assume "(- c' / b') = (- e + - 1 * sqrt (e^2 - 4 * d' * f)) / (2 * d')" then have "(d', e, f) ∈ set d ∧ d' ≠ 0 ∧ - e⇧2 + 4 * d' * f ≤ 0 ∧ ((∀(d, e, f)∈set a. ∃y'>?r1. ∀x∈{?r1<..y'}. d * x⇧2 + e * x + f = 0) ∧ (∀(d, e, f)∈set b. ∃y'>?r1. ∀x∈{?r1<..y'}. d * x⇧2 + e * x + f < 0) ∧ (∀(d, e, f)∈set c. ∃y'>?r1. ∀x∈{?r1<..y'}. d * x⇧2 + e * x + f ≤ 0) ∧ (∀(d, e, f)∈set d. ∃y'>?r1. ∀x∈{?r1<..y'}. d * x⇧2 + e * x + f ≠ 0))" using abc_prop some_props by auto then show "False" using f12 by auto qed have cf2: "(- c' / b') = (- e + 1 * sqrt (e^2 - 4 * d' * f)) / (2 * d') ⟹ False" proof - assume "(- c' / b') = (- e + 1 * sqrt (e^2 - 4 * d' * f)) / (2 * d')" then have "(d', e, f) ∈ set d ∧ d' ≠ 0 ∧ - e⇧2 + 4 * d' * f ≤ 0 ∧ ((∀(d, e, f)∈set a. ∃y'>?r2. ∀x∈{?r2<..y'}. d * x⇧2 + e * x + f = 0) ∧ (∀(d, e, f)∈set b. ∃y'>?r2. ∀x∈{?r2<..y'}. d * x⇧2 + e * x + f < 0) ∧ (∀(d, e, f)∈set c. ∃y'>?r2. ∀x∈{?r2<..y'}. d * x⇧2 + e * x + f ≤ 0) ∧ (∀(d, e, f)∈set d. ∃y'>?r2. ∀x∈{?r2<..y'}. d * x⇧2 + e * x + f ≠ 0))" using abc_prop some_props by auto then show "False" using f11 by auto qed then show "False" using two_cases cf1 cf2 by auto qed (* discriminant_nonnegative *) have eo: "(d' ≠ 0) ∨ (d' = 0 ∧ e ≠ 0) ∨ (d' = 0 ∧ e = 0 ∧ f = 0)" using def_prop by auto then show "False" using f1 f2 f3 by auto qed then show ?thesis by auto qed have "(∃(a', b', c')∈set c. (a' = 0 ∧ b' ≠ 0) ∧ (∀(d, e, f)∈set a. d * (- c' / b')⇧2 + e * (- c' / b') + f = 0) ∧ (∀(d, e, f)∈set b. d * (- c' / b')⇧2 + e * (- c' / b') + f < 0) ∧ (∀(d, e, f)∈set c. d * (- c' / b')⇧2 + e * (- c' / b') + f ≤ 0) ∧ (∀(d, e, f)∈set d. d * (- c' / b')⇧2 + e * (- c' / b') + f ≠ 0))" using h1 h2 h3 h4 bnonz abc_prop by auto then show "False" using f8 by auto qed then show ?thesis by auto qed lemma qe_forwards_helper: assumes alleqset: "∀x. (∀(d, e, f)∈set a. d * x^2 + e * x + f = 0)" assumes f1: "¬((∀(a, b, c)∈set a. a = 0 ∧ b = 0 ∧ c = 0) ∧ (∀(a, b, c)∈set b. ∃x. ∀y<x. a * y⇧2 + b * y + c < 0) ∧ (∀(a, b, c)∈set c. ∃x. ∀y<x. a * y⇧2 + b * y + c ≤ 0) ∧ (∀(a, b, c)∈set d. ∃x. ∀y<x. a * y⇧2 + b * y + c ≠ 0))" assumes f5: "¬(∃(a', b', c')∈set b. (a' = 0 ∧ b' ≠ 0) ∧ (∀(d, e, f)∈set a. ∃y'>- c' / b'. ∀x∈{- c' / b'<..y'}. d * x⇧2 + e * x + f = 0) ∧ (∀(d, e, f)∈set b. ∃y'>- c' / b'. ∀x∈{- c' / b'<..y'}. d * x⇧2 + e * x + f < 0) ∧ (∀(d, e, f)∈set c. ∃y'>- c' / b'. ∀x∈{- c' / b'<..y'}. d * x⇧2 + e * x + f ≤ 0) ∧ (∀(d, e, f)∈set d. ∃y'>- c' / b'. ∀x∈{- c' / b'<..y'}. d * x⇧2 + e * x + f ≠ 0))" assumes f6: "¬ (∃(a', b', c')∈set b. a' ≠ 0 ∧ - b'⇧2 + 4 * a' * c' ≤ 0 ∧ ((∀(d, e, f)∈set a. ∃y'>(- b' + 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a'). ∀x∈{(- b' + 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a')<..y'}. d * x⇧2 + e * x + f = 0) ∧ (∀(d, e, f)∈set b. ∃y'>(- b' + 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a'). ∀x∈{(- b' + 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a')<..y'}. d * x⇧2 + e * x + f < 0) ∧ (∀(d, e, f)∈set c. ∃y'>(- b' + 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a'). ∀x∈{(- b' + 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a')<..y'}. d * x⇧2 + e * x + f ≤ 0) ∧ (∀(d, e, f)∈set d. ∃y'>(- b' + 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a'). ∀x∈{(- b' + 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a')<..y'}. d * x⇧2 + e * x + f ≠ 0)))" assumes f7: "¬ (∃(a', b', c')∈set b. a' ≠ 0 ∧ - b'⇧2 + 4 * a' * c' ≤ 0 ∧ (∀(d, e, f)∈set a. ∃y'>(- b' + - 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a'). ∀x∈{(- b' + - 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a')<..y'}. d * x⇧2 + e * x + f = 0) ∧ (∀(d, e, f)∈set b. ∃y'>(- b' + - 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a'). ∀x∈{(- b' + - 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a')<..y'}. d * x⇧2 + e * x + f < 0) ∧ (∀(d, e, f)∈set c. ∃y'>(- b' + - 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a'). ∀x∈{(- b' + - 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a')<..y'}. d * x⇧2 + e * x + f ≤ 0) ∧ (∀(d, e, f)∈set d. ∃y'>(- b' + - 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a'). ∀x∈{(- b' + - 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a')<..y'}. d * x⇧2 + e * x + f ≠ 0))" assumes f8: "¬(∃(a', b', c')∈set c. (a' = 0 ∧ b' ≠ 0) ∧ (∀(d, e, f)∈set a. d * (- c' / b')⇧2 + e * (- c' / b') + f = 0) ∧ (∀(d, e, f)∈set b. d * (- c' / b')⇧2 + e * (- c' / b') + f < 0) ∧ (∀(d, e, f)∈set c. d * (- c' / b')⇧2 + e * (- c' / b') + f ≤ 0) ∧ (∀(d, e, f)∈set d. d * (- c' / b')⇧2 + e * (- c' / b') + f ≠ 0))" assumes f13: "¬(∃(a', b', c')∈set c. a' ≠ 0 ∧ - b'⇧2 + 4 * a' * c' ≤ 0 ∧ ((∀(d, e, f)∈set a. d * ((- b' + 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a'))⇧2 + e * ((- b' + 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a')) + f = 0) ∧ (∀(d, e, f)∈set b. d * ((- b' + 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a'))⇧2 + e * ((- b' + 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a')) + f < 0) ∧ (∀(d, e, f)∈set c. d * ((- b' + 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a'))⇧2 + e * ((- b' + 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a')) + f ≤ 0) ∧ (∀(d, e, f)∈set d. d * ((- b' + 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a'))⇧2 + e * ((- b' + 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a')) + f ≠ 0)))" assumes f9: "¬(∃(a', b', c')∈set c. a' ≠ 0 ∧ - b'⇧2 + 4 * a' * c' ≤ 0 ∧ (∀(d, e, f)∈set a. d * ((- b' + - 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a'))⇧2 + e * ((- b' + - 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a')) + f = 0) ∧ (∀(d, e, f)∈set b. d * ((- b' + - 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a'))⇧2 + e * ((- b' + - 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a')) + f < 0) ∧ (∀(d, e, f)∈set c. d * ((- b' + - 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a'))⇧2 + e * ((- b' + - 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a')) + f ≤ 0) ∧ (∀(d, e, f)∈set d. d * ((- b' + - 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a'))⇧2 + e * ((- b' + - 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a')) + f ≠ 0))" assumes f10: "¬(∃(a', b', c')∈set d. (a' = 0 ∧ b' ≠ 0) ∧ (∀(d, e, f)∈set a. ∃y'>- c' / b'. ∀x∈{- c' / b'<..y'}. d * x⇧2 + e * x + f = 0) ∧ (∀(d, e, f)∈set b. ∃y'>- c' / b'. ∀x∈{- c' / b'<..y'}. d * x⇧2 + e * x + f < 0) ∧ (∀(d, e, f)∈set c. ∃y'>- c' / b'. ∀x∈{- c' / b'<..y'}. d * x⇧2 + e * x + f ≤ 0) ∧ (∀(d, e, f)∈set d. ∃y'>- c' / b'. ∀x∈{- c' / b'<..y'}. d * x⇧2 + e * x + f ≠ 0))" assumes f11: "¬(∃(a', b', c')∈set d. a' ≠ 0 ∧ - b'⇧2 + 4 * a' * c' ≤ 0 ∧ ((∀(d, e, f)∈set a. ∃y'>(- b' + 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a'). ∀x∈{(- b' + 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a')<..y'}. d * x⇧2 + e * x + f = 0) ∧ (∀(d, e, f)∈set b. ∃y'>(- b' + 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a'). ∀x∈{(- b' + 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a')<..y'}. d * x⇧2 + e * x + f < 0) ∧ (∀(d, e, f)∈set c. ∃y'>(- b' + 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a'). ∀x∈{(- b' + 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a')<..y'}. d * x⇧2 + e * x + f ≤ 0) ∧ (∀(d, e, f)∈set d. ∃y'>(- b' + 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a'). ∀x∈{(- b' + 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a')<..y'}. d * x⇧2 + e * x + f ≠ 0)))" assumes f12: "¬(∃(a', b', c')∈set d. a' ≠ 0 ∧ - b'⇧2 + 4 * a' * c' ≤ 0 ∧ (∀(d, e, f)∈set a. ∃y'>(- b' + - 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a'). ∀x∈{(- b' + - 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a')<..y'}. d * x⇧2 + e * x + f = 0) ∧ (∀(d, e, f)∈set b. ∃y'>(- b' + - 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a'). ∀x∈{(- b' + - 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a')<..y'}. d * x⇧2 + e * x + f < 0) ∧ (∀(d, e, f)∈set c. ∃y'>(- b' + - 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a'). ∀x∈{(- b' + - 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a')<..y'}. d * x⇧2 + e * x + f ≤ 0) ∧ (∀(d, e, f)∈set d. ∃y'>(- b' + - 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a'). ∀x∈{(- b' + - 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a')<..y'}. d * x⇧2 + e * x + f ≠ 0))" shows "¬(∃x. (∀(a, b, c)∈set b. a * x⇧2 + b * x + c < 0) ∧ (∀(a, b, c)∈set c. a * x⇧2 + b * x + c ≤ 0) ∧ (∀(a, b, c)∈set d. a * x⇧2 + b * x + c ≠ 0))" proof - have nor: "∀r. ¬(∃(a', b', c')∈set c. ((a'≠ 0 ∨ b'≠ 0) ∧ a'*r^2 + b'*r + c' = 0) ∧ ((∀(d, e, f)∈set a. d * r⇧2 + e * r + f = 0) ∧ (∀(d, e, f)∈set b. d * r^2 + e * r + f < 0) ∧ (∀(d, e, f)∈set c. d * r^2 + e * r + f ≤ 0) ∧ (∀(d, e, f)∈set d. d * r^2 + e * r + f ≠ 0)))" proof clarsimp fix r t u v assume inset: "(t, u, v) ∈ set c" assume eo: "t = 0 ⟶ u ≠ 0 " assume zero_eq: "t*r^2 + u*r + v = 0" assume ah: "∀x∈set a. case x of (d, e, f) ⇒ d * r⇧2 + e * r + f = 0" assume bh: "∀x∈set b. case x of (d, e, f) ⇒ d * r⇧2 + e * r + f < 0" assume ch: "∀x∈set c. case x of (d, e, f) ⇒ d * r⇧2 + e * r + f ≤ 0" assume dh: "∀x∈set d. case x of (d, e, f) ⇒ d * r⇧2 + e * r + f ≠ 0" have two_cases: "t ≠ 0 ∨ (t = 0 ∧ u ≠ 0)" using eo by auto have c1: "t ≠ 0 ⟹ False" proof - assume tnonz: "t ≠ 0" then have discr_prop: "- u⇧2 + 4 * t * v ≤ 0 " using discriminant_negative[of t u v] zero_eq unfolding discrim_def by force then have ris: "r = ((-u + - 1 * sqrt (u^2 - 4 * t * v)) / (2 * t)) ∨ r = ((-u + 1 * sqrt (u^2 - 4 * t * v)) / (2 * t)) " using tnonz discriminant_nonneg[of t u v] zero_eq unfolding discrim_def by auto let ?r1 = "((-u + - 1 * sqrt (u^2 - 4 * t * v)) / (2 * t))" let ?r2 = "((-u + 1 * sqrt (u^2 - 4 * t * v)) / (2 * t))" have ris1: "r = ?r1 ⟹ False" proof - assume "r = ?r1" then have "(∃(a', b', c')∈set c. a' ≠ 0 ∧ - b'⇧2 + 4 * a' * c' ≤ 0 ∧ (∀(d, e, f)∈set a. d * ((- b' + - 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a'))⇧2 + e * ((- b' + - 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a')) + f = 0) ∧ (∀(d, e, f)∈set b. d * ((- b' + - 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a'))⇧2 + e * ((- b' + - 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a')) + f < 0) ∧ (∀(d, e, f)∈set c. d * ((- b' + - 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a'))⇧2 + e * ((- b' + - 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a')) + f ≤ 0) ∧ (∀(d, e, f)∈set d. d * ((- b' + - 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a'))⇧2 + e * ((- b' + - 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a')) + f ≠ 0))" using inset ah bh ch dh discr_prop tnonz by auto then show ?thesis using f9 by auto qed have ris2: "r = ?r2 ⟹ False" proof - assume "r = ?r2" then have "(∃(a', b', c')∈set c. a' ≠ 0 ∧ - b'⇧2 + 4 * a' * c' ≤ 0 ∧ ((∀(d, e, f)∈set a. d * ((- b' + 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a'))⇧2 + e * ((- b' + 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a')) + f = 0) ∧ (∀(d, e, f)∈set b. d * ((- b' + 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a'))⇧2 + e * ((- b' + 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a')) + f < 0) ∧ (∀(d, e, f)∈set c. d * ((- b' + 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a'))⇧2 + e * ((- b' + 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a')) + f ≤ 0) ∧ (∀(d, e, f)∈set d. d * ((- b' + 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a'))⇧2 + e * ((- b' + 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a')) + f ≠ 0)))" using inset ah bh ch dh discr_prop tnonz by auto then show ?thesis using f13 by auto qed show "False" using ris ris1 ris2 by auto qed have c2: "(t = 0 ∧ u ≠ 0) ⟹ False" proof - assume asm: "t = 0 ∧ u ≠ 0" then have "r = -v/u" using zero_eq add.right_neutral nonzero_mult_div_cancel_left by (metis add.commute divide_divide_eq_right divide_eq_0_iff neg_eq_iff_add_eq_0) then have "(∃(a', b', c')∈set c. (a' = 0 ∧ b' ≠ 0) ∧ (∀(d, e, f)∈set a. d * (- c' / b')⇧2 + e * (- c' / b') + f = 0) ∧ (∀(d, e, f)∈set b. d * (- c' / b')⇧2 + e * (- c' / b') + f < 0) ∧ (∀(d, e, f)∈set c. d * (- c' / b')⇧2 + e * (- c' / b') + f ≤ 0) ∧ (∀(d, e, f)∈set d. d * (- c' / b')⇧2 + e * (- c' / b') + f ≠ 0))" using asm inset ah bh ch dh by auto then show "False" using f8 by auto qed then show "False" using two_cases c1 c2 by auto qed have keyh: "⋀r. ¬(∃(a', b', c')∈set c. ((a'≠ 0 ∨ b'≠ 0) ∧ a'*r^2 + b'*r + c' = 0) ∧ (∀(d, e, f)∈set a. ∃y'>r. ∀x∈{r<..y'}. d * x⇧2 + e * x + f = 0) ∧ (∀(d, e, f)∈set b. ∃y'>r. ∀x∈{r<..y'}. d * x⇧2 + e * x + f < 0) ∧ (∀(d, e, f)∈set c. ∃y'>r. ∀x∈{r<..y'}. d * x⇧2 + e * x + f ≤ 0) ∧ (∀(d, e, f)∈set d. ∃y'>r. ∀x∈{r<..y'}. d * x⇧2 + e * x + f ≠ 0))" proof - fix r have h8: "¬(∃(a', b', c')∈set c. ((a'≠ 0 ∨ b'≠ 0) ∧ a'*r^2 + b'*r + c' = 0) ∧ ((∀(d, e, f)∈set a. d * r⇧2 + e * r + f = 0) ∧ (∀(d, e, f)∈set b. d * r^2 + e * r + f < 0) ∧ (∀(d, e, f)∈set c. d * r^2 + e * r + f ≤ 0) ∧ (∀(d, e, f)∈set d. d * r^2 + e * r + f ≠ 0)))" using nor by auto show "¬(∃(a', b', c')∈set c. ((a'≠ 0 ∨ b'≠ 0) ∧ a'*r^2 + b'*r + c' = 0) ∧ (∀(d, e, f)∈set a. ∃y'>r. ∀x∈{r<..y'}. d * x⇧2 + e * x + f = 0) ∧ (∀(d, e, f)∈set b. ∃y'>r. ∀x∈{r<..y'}. d * x⇧2 + e * x + f < 0) ∧ (∀(d, e, f)∈set c. ∃y'>r. ∀x∈{r<..y'}. d * x⇧2 + e * x + f ≤ 0) ∧ (∀(d, e, f)∈set d. ∃y'>r. ∀x∈{r<..y'}. d * x⇧2 + e * x + f ≠ 0))" using qe_forwards_helper_gen[of c r a b d] alleqset f5 f6 f7 h8 f10 f11 f12 by auto qed have f8a: "¬(∃(a', b', c')∈set c. (a' = 0 ∧ b' ≠ 0) ∧ (∀(d, e, f)∈set a. ∃y'>- c' / b'. ∀x∈{- c' / b'<..y'}. d * x⇧2 + e * x + f = 0) ∧ (∀(d, e, f)∈set b. ∃y'>- c' / b'. ∀x∈{- c' / b'<..y'}. d * x⇧2 + e * x + f < 0) ∧ (∀(d, e, f)∈set c. ∃y'>- c' / b'. ∀x∈{- c' / b'<..y'}. d * x⇧2 + e * x + f ≤ 0) ∧ (∀(d, e, f)∈set d. ∃y'>- c' / b'. ∀x∈{- c' / b'<..y'}. d * x⇧2 + e * x + f ≠ 0))" using qe_forwards_helper_lin[of a b c d] alleqset f5 f6 f7 f8 f10 f11 f12 by blast have f13a: "¬ (∃(a', b', c')∈set c. a' ≠ 0 ∧ - b'⇧2 + 4 * a' * c' ≤ 0 ∧ ((∀(d, e, f)∈set a. ∃y'>(- b' + 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a'). ∀x∈{(- b' + 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a')<..y'}. d * x⇧2 + e * x + f = 0) ∧ (∀(d, e, f)∈set b. ∃y'>(- b' + 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a'). ∀x∈{(- b' + 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a')<..y'}. d * x⇧2 + e * x + f < 0) ∧ (∀(d, e, f)∈set c. ∃y'>(- b' + 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a'). ∀x∈{(- b' + 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a')<..y'}. d * x⇧2 + e * x + f ≤ 0) ∧ (∀(d, e, f)∈set d. ∃y'>(- b' + 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a'). ∀x∈{(- b' + 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a')<..y'}. d * x⇧2 + e * x + f ≠ 0)))" proof - have "(∃(a', b', c')∈set c. a' ≠ 0 ∧ - b'⇧2 + 4 * a' * c' ≤ 0 ∧ ((∀(d, e, f)∈set a. ∃y'>(- b' + 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a'). ∀x∈{(- b' + 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a')<..y'}. d * x⇧2 + e * x + f = 0) ∧ (∀(d, e, f)∈set b. ∃y'>(- b' + 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a'). ∀x∈{(- b' + 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a')<..y'}. d * x⇧2 + e * x + f < 0) ∧ (∀(d, e, f)∈set c. ∃y'>(- b' + 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a'). ∀x∈{(- b' + 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a')<..y'}. d * x⇧2 + e * x + f ≤ 0) ∧ (∀(d, e, f)∈set d. ∃y'>(- b' + 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a'). ∀x∈{(- b' + 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a')<..y'}. d * x⇧2 + e * x + f ≠ 0))) ⟹ False" proof - assume "(∃(a', b', c')∈set c. a' ≠ 0 ∧ - b'⇧2 + 4 * a' * c' ≤ 0 ∧ ((∀(d, e, f)∈set a. ∃y'>(- b' + 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a'). ∀x∈{(- b' + 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a')<..y'}. d * x⇧2 + e * x + f = 0) ∧ (∀(d, e, f)∈set b. ∃y'>(- b' + 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a'). ∀x∈{(- b' + 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a')<..y'}. d * x⇧2 + e * x + f < 0) ∧ (∀(d, e, f)∈set c. ∃y'>(- b' + 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a'). ∀x∈{(- b' + 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a')<..y'}. d * x⇧2 + e * x + f ≤ 0) ∧ (∀(d, e, f)∈set d. ∃y'>(- b' + 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a'). ∀x∈{(- b' + 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a')<..y'}. d * x⇧2 + e * x + f ≠ 0)))" then obtain a' b' c' where abc_prop: "(a', b', c')∈set c ∧ a' ≠ 0 ∧ - b'⇧2 + 4 * a' * c' ≤ 0 ∧ ((∀(d, e, f)∈set a. ∃y'>(- b' + 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a'). ∀x∈{(- b' + 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a')<..y'}. d * x⇧2 + e * x + f = 0) ∧ (∀(d, e, f)∈set b. ∃y'>(- b' + 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a'). ∀x∈{(- b' + 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a')<..y'}. d * x⇧2 + e * x + f < 0) ∧ (∀(d, e, f)∈set c. ∃y'>(- b' + 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a'). ∀x∈{(- b' + 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a')<..y'}. d * x⇧2 + e * x + f ≤ 0) ∧ (∀(d, e, f)∈set d. ∃y'>(- b' + 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a'). ∀x∈{(- b' + 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a')<..y'}. d * x⇧2 + e * x + f ≠ 0))" by auto let ?r = "(- b' + 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a')" have somek: "∃k. k = ?r" by auto then obtain k where k_prop: "k = ?r" by auto have "(a'≠ 0 ∨ b'≠ 0) ∧ (a'*?r^2 + b'*?r + c' = 0)" using abc_prop discriminant_nonneg[of a' b' c'] unfolding discrim_def apply (auto) by (metis (mono_tags, lifting) times_divide_eq_right) then have "(∃(a', b', c')∈set c. ((a'≠ 0 ∨ b'≠ 0) ∧ a'*?r^2 + b'*?r + c' = 0) ∧ (∀(d, e, f)∈set a. ∃y'>?r. ∀x∈{?r<..y'}. d * x⇧2 + e * x + f = 0) ∧ (∀(d, e, f)∈set b. ∃y'>?r. ∀x∈{?r<..y'}. d * x⇧2 + e * x + f < 0) ∧ (∀(d, e, f)∈set c. ∃y'>?r. ∀x∈{?r<..y'}. d * x⇧2 + e * x + f ≤ 0) ∧ (∀(d, e, f)∈set d. ∃y'>?r. ∀x∈{?r<..y'}. d * x⇧2 + e * x + f ≠ 0))" using abc_prop by auto then have "(∃(a', b', c')∈set c. ((a'≠ 0 ∨ b'≠ 0) ∧ a'*k^2 + b'*k + c' = 0) ∧ (∀(d, e, f)∈set a. ∃y'>k. ∀x∈{k<..y'}. d * x⇧2 + e * x + f = 0) ∧ (∀(d, e, f)∈set b. ∃y'>k. ∀x∈{k<..y'}. d * x⇧2 + e * x + f < 0) ∧ (∀(d, e, f)∈set c. ∃y'>k. ∀x∈{k<..y'}. d * x⇧2 + e * x + f ≤ 0) ∧ (∀(d, e, f)∈set d. ∃y'>k. ∀x∈{k<..y'}. d * x⇧2 + e * x + f ≠ 0))" using k_prop by auto then have "∃k. (∃(a', b', c')∈set c. ((a'≠ 0 ∨ b'≠ 0) ∧ a'*k^2 + b'*k + c' = 0) ∧ (∀(d, e, f)∈set a. ∃y'>k. ∀x∈{k<..y'}. d * x⇧2 + e * x + f = 0) ∧ (∀(d, e, f)∈set b. ∃y'>k. ∀x∈{k<..y'}. d * x⇧2 + e * x + f < 0) ∧ (∀(d, e, f)∈set c. ∃y'>k. ∀x∈{k<..y'}. d * x⇧2 + e * x + f ≤ 0) ∧ (∀(d, e, f)∈set d. ∃y'>k. ∀x∈{k<..y'}. d * x⇧2 + e * x + f ≠ 0))" by auto then show "False" using keyh by auto qed then show ?thesis by auto qed have f9a: "¬ (∃(a', b', c')∈set c. a' ≠ 0 ∧ - b'⇧2 + 4 * a' * c' ≤ 0 ∧ (∀(d, e, f)∈set a. ∃y'>(- b' + - 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a'). ∀x∈{(- b' + - 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a')<..y'}. d * x⇧2 + e * x + f = 0) ∧ (∀(d, e, f)∈set b. ∃y'>(- b' + - 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a'). ∀x∈{(- b' + - 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a')<..y'}. d * x⇧2 + e * x + f < 0) ∧ (∀(d, e, f)∈set c. ∃y'>(- b' + - 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a'). ∀x∈{(- b' + - 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a')<..y'}. d * x⇧2 + e * x + f ≤ 0) ∧ (∀(d, e, f)∈set d. ∃y'>(- b' + - 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a'). ∀x∈{(- b' + - 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a')<..y'}. d * x⇧2 + e * x + f ≠ 0))" proof - have "(∃(a', b', c')∈set c. a' ≠ 0 ∧ - b'⇧2 + 4 * a' * c' ≤ 0 ∧ (∀(d, e, f)∈set a. ∃y'>(- b' + - 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a'). ∀x∈{(- b' + - 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a')<..y'}. d * x⇧2 + e * x + f = 0) ∧ (∀(d, e, f)∈set b. ∃y'>(- b' + - 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a'). ∀x∈{(- b' + - 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a')<..y'}. d * x⇧2 + e * x + f < 0) ∧ (∀(d, e, f)∈set c. ∃y'>(- b' + - 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a'). ∀x∈{(- b' + - 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a')<..y'}. d * x⇧2 + e * x + f ≤ 0) ∧ (∀(d, e, f)∈set d. ∃y'>(- b' + - 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a'). ∀x∈{(- b' + - 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a')<..y'}. d * x⇧2 + e * x + f ≠ 0)) ⟹ False" proof - assume "(∃(a', b', c')∈set c. a' ≠ 0 ∧ - b'⇧2 + 4 * a' * c' ≤ 0 ∧ (∀(d, e, f)∈set a. ∃y'>(- b' + - 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a'). ∀x∈{(- b' + - 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a')<..y'}. d * x⇧2 + e * x + f = 0) ∧ (∀(d, e, f)∈set b. ∃y'>(- b' + - 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a'). ∀x∈{(- b' + - 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a')<..y'}. d * x⇧2 + e * x + f < 0) ∧ (∀(d, e, f)∈set c. ∃y'>(- b' + - 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a'). ∀x∈{(- b' + - 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a')<..y'}. d * x⇧2 + e * x + f ≤ 0) ∧ (∀(d, e, f)∈set d. ∃y'>(- b' + - 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a'). ∀x∈{(- b' + - 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a')<..y'}. d * x⇧2 + e * x + f ≠ 0))" then obtain a' b' c' where abc_prop: "(a', b', c')∈set c ∧ a' ≠ 0 ∧ - b'⇧2 + 4 * a' * c' ≤ 0 ∧ (∀(d, e, f)∈set a. ∃y'>(- b' + - 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a'). ∀x∈{(- b' + - 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a')<..y'}. d * x⇧2 + e * x + f = 0) ∧ (∀(d, e, f)∈set b. ∃y'>(- b' + - 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a'). ∀x∈{(- b' + - 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a')<..y'}. d * x⇧2 + e * x + f < 0) ∧ (∀(d, e, f)∈set c. ∃y'>(- b' + - 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a'). ∀x∈{(- b' + - 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a')<..y'}. d * x⇧2 + e * x + f ≤ 0) ∧ (∀(d, e, f)∈set d. ∃y'>(- b' + - 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a'). ∀x∈{(- b' + - 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a')<..y'}. d * x⇧2 + e * x + f ≠ 0)" by auto let ?r = "(- b' + - 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a')" have somek: "∃k. k = ?r" by auto then obtain k where k_prop: "k = ?r" by auto have "(a'≠ 0 ∨ b'≠ 0) ∧ (a'*?r^2 + b'*?r + c' = 0)" using abc_prop discriminant_nonneg[of a' b' c'] unfolding discrim_def apply (auto) by (metis (mono_tags, lifting) times_divide_eq_right) then have "(∃(a', b', c')∈set c. ((a'≠ 0 ∨ b'≠ 0) ∧ a'*?r^2 + b'*?r + c' = 0) ∧ (∀(d, e, f)∈set a. ∃y'>?r. ∀x∈{?r<..y'}. d * x⇧2 + e * x + f = 0) ∧ (∀(d, e, f)∈set b. ∃y'>?r. ∀x∈{?r<..y'}. d * x⇧2 + e * x + f < 0) ∧ (∀(d, e, f)∈set c. ∃y'>?r. ∀x∈{?r<..y'}. d * x⇧2 + e * x + f ≤ 0) ∧ (∀(d, e, f)∈set d. ∃y'>?r. ∀x∈{?r<..y'}. d * x⇧2 + e * x + f ≠ 0))" using abc_prop by auto then have "(∃(a', b', c')∈set c. ((a'≠ 0 ∨ b'≠ 0) ∧ a'*k^2 + b'*k + c' = 0) ∧ (∀(d, e, f)∈set a. ∃y'>k. ∀x∈{k<..y'}. d * x⇧2 + e * x + f = 0) ∧ (∀(d, e, f)∈set b. ∃y'>k. ∀x∈{k<..y'}. d * x⇧2 + e * x + f < 0) ∧ (∀(d, e, f)∈set c. ∃y'>k. ∀x∈{k<..y'}. d * x⇧2 + e * x + f ≤ 0) ∧ (∀(d, e, f)∈set d. ∃y'>k. ∀x∈{k<..y'}. d * x⇧2 + e * x + f ≠ 0))" using k_prop by auto then have "∃k. (∃(a', b', c')∈set c. ((a'≠ 0 ∨ b'≠ 0) ∧ a'*k^2 + b'*k + c' = 0) ∧ (∀(d, e, f)∈set a. ∃y'>k. ∀x∈{k<..y'}. d * x⇧2 + e * x + f = 0) ∧ (∀(d, e, f)∈set b. ∃y'>k. ∀x∈{k<..y'}. d * x⇧2 + e * x + f < 0) ∧ (∀(d, e, f)∈set c. ∃y'>k. ∀x∈{k<..y'}. d * x⇧2 + e * x + f ≤ 0) ∧ (∀(d, e, f)∈set d. ∃y'>k. ∀x∈{k<..y'}. d * x⇧2 + e * x + f ≠ 0))" by auto then show "False" using keyh by auto qed then show ?thesis by auto qed (* We need to show that the point is in one of these ranges *) have "(∃x. (∀(a, b, c)∈set b. a * x⇧2 + b * x + c < 0) ∧ (∀(a, b, c)∈set c. a * x⇧2 + b * x + c ≤ 0) ∧ (∀(a, b, c)∈set d. a * x⇧2 + b * x + c ≠ 0)) ⟹ False" proof - assume "(∃x. (∀(a, b, c)∈set b. a * x⇧2 + b * x + c < 0) ∧ (∀(a, b, c)∈set c. a * x⇧2 + b * x + c ≤ 0) ∧ (∀(a, b, c)∈set d. a * x⇧2 + b * x + c ≠ 0))" then obtain x where x_prop: "(∀(a, b, c)∈set b. a * x⇧2 + b * x + c < 0) ∧ (∀(a, b, c)∈set c. a * x⇧2 + b * x + c ≤ 0) ∧ (∀(a, b, c)∈set d. a * x⇧2 + b * x + c ≠ 0)" by auto (* Need this sorted_nonzero_root_list_set in case some of the tuples from set c are (0, 0, 0) *) let ?srl = "sorted_nonzero_root_list_set (((set b) ∪ (set c))∪ (set d))" have alleqsetvar: "∀(t, u, v) ∈ set a. t = 0 ∧ u = 0 ∧ v = 0" proof clarsimp fix t u v assume "(t, u, v) ∈ set a" then have "∀x. t*x^2 + u*x + v = 0" using alleqset by auto then have "∀x∈{0<..1}. t * x⇧2 + u * x + v = 0" by auto then show "t = 0 ∧ u = 0 ∧ v = 0" using continuity_lem_eq0[of 0 1 t u v] by auto qed (* Should violate f1 *) have lenzero: "length ?srl = 0 ⟹ False" proof - assume lenzero: "length ?srl = 0" have ina: "(∀(a, b, c)∈set a. a = 0 ∧ b = 0 ∧ c = 0)" using alleqsetvar by auto have inb: "(∀(a, b, c)∈set b. ∀y. a * y⇧2 + b * y + c < 0)" proof clarsimp fix t u v y assume insetb: "(t, u, v) ∈ set b" then have "t * x⇧2 + u * x + v < 0" using x_prop by auto then have tuv_prop: "t ≠ 0 ∨ u ≠ 0 ∨ v ≠ 0" by auto then have tuzer: "(t = 0 ∧ u = 0) ⟹ ¬(∃q. t * q⇧2 + u * q + v = 0)" by simp then have tunonz: "(t ≠ 0 ∨ u ≠ 0) ⟹ ¬(∃q. t * q⇧2 + u * q + v = 0)" proof - assume tuv_asm: "t ≠ 0 ∨ u ≠ 0" have "∃q. t * q⇧2 + u * q + v = 0 ⟹ False" proof - assume "∃ q. t * q⇧2 + u * q + v = 0" then obtain q where "t * q⇧2 + u * q + v = 0" by auto then have qin: "q ∈ {x. ∃(a, b, c)∈set b ∪ set c ∪ set d. (a ≠ 0 ∨ b ≠ 0) ∧ a * x⇧2 + b * x + c = 0}" using insetb tuv_asm tuv_prop by auto have "set ?srl = nonzero_root_set (set b ∪ set c ∪ set d)" unfolding sorted_nonzero_root_list_set_def using set_sorted_list_of_set[of "nonzero_root_set (set b ∪ set c ∪ set d)"] nonzero_root_set_finite[of "(set b ∪ set c ∪ set d)"] by auto then have "q ∈ set ?srl" using qin unfolding nonzero_root_set_def by auto then have "List.member ?srl q" using in_set_member[of q ?srl] by auto then show "False" using lenzero by (simp add: member_rec(2)) qed then show ?thesis by auto qed have nozer: "¬(∃q. t * q⇧2 + u * q + v = 0)" using tuzer tunonz by blast have samesn: "sign_num (t*x^2 + u*x + v) = sign_num (t*y^2 + u*y + v)" proof - have "x < y ⟹ sign_num (t*x^2 + u*x + v) = sign_num (t*y^2 + u*y + v)" using changes_sign_var[of t x u v y] nozer by auto have "y < x ⟹ sign_num (t*x^2 + u*x + v) = sign_num (t*y^2 + u*y + v)" using changes_sign_var[of t y u v x] nozer proof - assume "y < x" then show ?thesis using ‹∄q. t * q⇧2 + u * q + v = 0› ‹sign_num (t * y⇧2 + u * y + v) ≠ sign_num (t * x⇧2 + u * x + v) ∧ y < x ⟹ ∃q. t * q⇧2 + u * q + v = 0 ∧ y ≤ q ∧ q ≤ x› by presburger qed show ?thesis using changes_sign_var using ‹x < y ⟹ sign_num (t * x⇧2 + u * x + v) = sign_num (t * y⇧2 + u * y + v)› ‹y < x ⟹ sign_num (t * x⇧2 + u * x + v) = sign_num (t * y⇧2 + u * y + v)› by fastforce qed (* changes_sign_var *) have "sign_num (t*x^2 + u*x + v) = -1" using insetb unfolding sign_num_def using x_prop by auto then have "sign_num (t*y^2 + u*y + v) = -1" using samesn by auto then show "t * y⇧2 + u * y + v < 0" unfolding sign_num_def by smt qed have inc: "(∀(a, b, c)∈set c. ∀y. a * y⇧2 + b * y + c ≤ 0)" proof clarsimp fix t u v y assume insetc: "(t, u, v) ∈ set c" then have "t * x⇧2 + u * x + v ≤ 0" using x_prop by auto then have tuzer: "t = 0 ∧ u = 0 ⟹ t*y^2 + u*y + v ≤ 0 " proof - assume tandu: "t = 0 ∧ u = 0" then have "v ≤ 0" using insetc x_prop by auto then show "t*y^2 + u*y + v ≤ 0" using tandu by auto qed have tunonz: "t ≠ 0 ∨ u ≠ 0 ⟹ t*y^2 + u*y + v ≤ 0" proof - assume tuv_asm: "t ≠ 0 ∨ u ≠ 0" have insetcvar: "t*x^2 + u*x + v < 0" proof - have "t*x^2 + u*x + v = 0 ⟹ False" proof - assume zer: "t*x^2 + u*x + v = 0" then have xin: "x ∈ {x. ∃(a, b, c)∈set b ∪ set c ∪ set d. (a ≠ 0 ∨ b ≠ 0) ∧ a * x⇧2 + b * x + c = 0}" using insetc tuv_asm by auto have "set ?srl = nonzero_root_set (set b ∪ set c ∪ set d)" unfolding sorted_nonzero_root_list_set_def using set_sorted_list_of_set[of "nonzero_root_set (set b ∪ set c ∪ set d)"] nonzero_root_set_finite[of "(set b ∪ set c ∪ set d)"] by auto then have "x ∈ set ?srl" using xin unfolding nonzero_root_set_def by auto then have "List.member ?srl x" using in_set_member[of x ?srl] by auto then show "False" using lenzero by (simp add: member_rec(2)) qed then show ?thesis using ‹t * x⇧2 + u * x + v ≤ 0› by fastforce qed then have tunonz: "¬(∃q. t * q⇧2 + u * q + v = 0)" proof - have "∃q. t * q⇧2 + u * q + v = 0 ⟹ False" proof - assume "∃ q. t * q⇧2 + u * q + v = 0" then obtain q where "t * q⇧2 + u * q + v = 0" by auto then have qin: "q ∈ {x. ∃(a, b, c)∈set b ∪ set c ∪ set d. (a ≠ 0 ∨ b ≠ 0) ∧ a * x⇧2 + b * x + c = 0}" using insetc tuv_asm by auto have "set ?srl = nonzero_root_set (set b ∪ set c ∪ set d)" unfolding sorted_nonzero_root_list_set_def using set_sorted_list_of_set[of "nonzero_root_set (set b ∪ set c ∪ set d)"] nonzero_root_set_finite[of "(set b ∪ set c ∪ set d)"] by auto then have "q ∈ set ?srl" using qin unfolding nonzero_root_set_def by auto then have "List.member ?srl q" using in_set_member[of q ?srl] by auto then show "False" using lenzero by (simp add: member_rec(2)) qed then show ?thesis by auto qed have nozer: "¬(∃q. t * q⇧2 + u * q + v = 0)" using tuzer tunonz by blast have samesn: "sign_num (t*x^2 + u*x + v) = sign_num (t*y^2 + u*y + v)" proof - have "x < y ⟹ sign_num (t*x^2 + u*x + v) = sign_num (t*y^2 + u*y + v)" using changes_sign_var[of t x u v y] nozer by auto have "y < x ⟹ sign_num (t*x^2 + u*x + v) = sign_num (t*y^2 + u*y + v)" using changes_sign_var[of t y u v x] nozer proof - assume "y < x" then show ?thesis using ‹∄q. t * q⇧2 + u * q + v = 0› ‹sign_num (t * y⇧2 + u * y + v) ≠ sign_num (t * x⇧2 + u * x + v) ∧ y < x ⟹ ∃q. t * q⇧2 + u * q + v = 0 ∧ y ≤ q ∧ q ≤ x› by presburger qed show ?thesis using changes_sign_var using ‹x < y ⟹ sign_num (t * x⇧2 + u * x + v) = sign_num (t * y⇧2 + u * y + v)› ‹y < x ⟹ sign_num (t * x⇧2 + u * x + v) = sign_num (t * y⇧2 + u * y + v)› by fastforce qed (* changes_sign_var *) have "sign_num (t*x^2 + u*x + v) = -1" using insetcvar unfolding sign_num_def using x_prop by auto then have "sign_num (t*y^2 + u*y + v) = -1" using samesn by auto then show "t * y⇧2 + u * y + v ≤ 0" unfolding sign_num_def by smt qed then show "t * y⇧2 + u * y + v ≤ 0" using tuzer tunonz by blast qed have ind: "(∀(a, b, c)∈set d. ∀y. a * y⇧2 + b * y + c ≠ 0)" proof clarsimp fix t u v y assume insetd: "(t, u, v) ∈ set d" assume falseasm: "t * y⇧2 + u * y + v = 0" then have snz: "sign_num (t*y^2 + u*y + v) = 0" unfolding sign_num_def by auto have "t * x⇧2 + u * x + v ≠ 0" using insetd x_prop by auto then have tuv_prop: "t ≠ 0 ∨ u ≠ 0 ∨ v ≠ 0" by auto then have tuzer: "(t = 0 ∧ u = 0) ⟹ ¬(∃q. t * q⇧2 + u * q + v = 0)" by simp then have tunonz: "(t ≠ 0 ∨ u ≠ 0) ⟹ ¬(∃q. t * q⇧2 + u * q + v = 0)" proof - assume tuv_asm: "t ≠ 0 ∨ u ≠ 0" have "∃q. t * q⇧2 + u * q + v = 0 ⟹ False" proof - assume "∃ q. t * q⇧2 + u * q + v = 0" then obtain q where "t * q⇧2 + u * q + v = 0" by auto then have qin: "q ∈ {x. ∃(a, b, c)∈set b ∪ set c ∪ set d. (a ≠ 0 ∨ b ≠ 0) ∧ a * x⇧2 + b * x + c = 0}" using insetd tuv_asm tuv_prop by auto have "set ?srl = nonzero_root_set (set b ∪ set c ∪ set d)" unfolding sorted_nonzero_root_list_set_def using set_sorted_list_of_set[of "nonzero_root_set (set b ∪ set c ∪ set d)"] nonzero_root_set_finite[of "(set b ∪ set c ∪ set d)"] by auto then have "q ∈ set ?srl" using qin unfolding nonzero_root_set_def by auto then have "List.member ?srl q" using in_set_member[of q ?srl] by auto then show "False" using lenzero by (simp add: member_rec(2)) qed then show ?thesis by auto qed have nozer: "¬(∃q. t * q⇧2 + u * q + v = 0)" using tuzer tunonz by blast have samesn: "sign_num (t*x^2 + u*x + v) = sign_num (t*y^2 + u*y + v)" proof - have "x < y ⟹ sign_num (t*x^2 + u*x + v) = sign_num (t*y^2 + u*y + v)" using changes_sign_var[of t x u v y] nozer by auto have "y < x ⟹ sign_num (t*x^2 + u*x + v) = sign_num (t*y^2 + u*y + v)" using changes_sign_var[of t y u v x] nozer proof - assume "y < x" then show ?thesis using ‹∄q. t * q⇧2 + u * q + v = 0› ‹sign_num (t * y⇧2 + u * y + v) ≠ sign_num (t * x⇧2 + u * x + v) ∧ y < x ⟹ ∃q. t * q⇧2 + u * q + v = 0 ∧ y ≤ q ∧ q ≤ x› by presburger qed show ?thesis using changes_sign_var using ‹x < y ⟹ sign_num (t * x⇧2 + u * x + v) = sign_num (t * y⇧2 + u * y + v)› ‹y < x ⟹ sign_num (t * x⇧2 + u * x + v) = sign_num (t * y⇧2 + u * y + v)› by fastforce qed (* changes_sign_var *) have "sign_num (t*x^2 + u*x + v) = -1 ∨ sign_num (t*x^2 + u*x + v) = 1 " using insetd unfolding sign_num_def using x_prop by auto then have "sign_num (t*y^2 + u*y + v) = -1 ∨ sign_num (t*y^2 + u*y + v) = 1" using samesn by auto then show "False" using snz by auto qed (* Show all the polynomials never change sign *) have "((∀(a, b, c)∈set a. a = 0 ∧ b = 0 ∧ c = 0) ∧ (∀(a, b, c)∈set b. ∀y. a * y⇧2 + b * y + c < 0) ∧ (∀(a, b, c)∈set c. ∀y. a * y⇧2 + b * y + c ≤ 0) ∧ (∀(a, b, c)∈set d. ∀y. a * y⇧2 + b * y + c ≠ 0))" using ina inb inc ind by auto then show "False" using f1 by auto qed have cases_mem: "(List.member ?srl x) ⟹ False" proof - assume "(List.member ?srl x)" then have "x ∈ {x. ∃(a, b, c)∈set b ∪ set c ∪ set d. (a ≠ 0 ∨ b ≠ 0) ∧ a * x⇧2 + b * x + c = 0}" using set_sorted_list_of_set nonzero_root_set_finite in_set_member by (metis List.finite_set finite_Un nonzero_root_set_def sorted_nonzero_root_list_set_def) then have "∃ (a, b, c) ∈ (((set b) ∪ (set c))∪ (set d)) . (a ≠ 0 ∨ b ≠ 0) ∧ a*x^2 + b*x + c = 0" by blast then obtain t u v where def_prop: "(t, u, v) ∈ (((set b) ∪ (set c))∪ (set d)) ∧ (t ≠ 0 ∨ u ≠ 0) ∧ t*x^2 + u*x + v = 0" by auto have notinb: "(t, u, v) ∉ (set b)" proof - have "(t, u, v) ∈ (set b ) ⟹ False" proof - assume "(t, u, v) ∈ (set b)" then have "t*x^2 + u*x + v < 0" using x_prop by blast then show "False" using def_prop by simp qed then show ?thesis by auto qed have notind: "(t, u, v) ∉ (set d)" proof - have "(t, u, v) ∈ (set d) ⟹ False" proof - assume "(t, u, v) ∈ (set d)" then have "t*x^2 + u*x + v ≠ 0" using x_prop by blast then show "False" using def_prop by simp qed then show ?thesis by auto qed then have inset: "(t, u, v) ∈ (set c)" using def_prop notinb notind by blast have case1: "t ≠ 0 ⟹ False" proof - assume tnonz: "t ≠ 0" then have r1or2:"x = (- u + - 1 * sqrt (u⇧2 - 4 * t * v)) / (2 * t) ∨ x = (- u + 1 * sqrt (u^2 - 4 * t * v)) / (2 * t) " using def_prop discriminant_negative[of t u v] discriminant_nonneg[of t u v] apply (auto) using notinb apply (force) apply (simp add: discrim_def discriminant_iff) using notind by force have discrh: "-1*u^2 + 4 * t * v ≤ 0" using tnonz discriminant_negative[of t u v] unfolding discrim_def using def_prop by force have r1: "x = (- u + - 1 * sqrt (u⇧2 - 4 * t * v)) / (2 * t) ⟹ False" proof - assume xis: "x = (- u + - 1 * sqrt (u⇧2 - 4 * t * v)) / (2 * t)" have " t ≠ 0 ∧ - 1*u^2 + 4 * t * v ≤ 0 ∧ (∀(d, e, f)∈set a. d * x⇧2 + e * x + f = 0) ∧ (∀(d, e, f)∈set b. d * x⇧2 + e * x + f < 0) ∧ (∀(d, e, f)∈set c. d * x⇧2 + e * x + f ≤ 0) ∧ (∀(d, e, f)∈set d. d * x⇧2 + e * x + f ≠ 0)" using tnonz alleqset discrh x_prop by auto then have "(∃(a', b', c')∈set c. a' ≠ 0 ∧ - b'⇧2 + 4 * a' * c' ≤ 0 ∧ (∀(d, e, f)∈set a. d * ((- b' + - 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a'))⇧2 + e * ((- b' + - 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a')) + f = 0) ∧ (∀(d, e, f)∈set b. d * ((- b' + - 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a'))⇧2 + e * ((- b' + - 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a')) + f < 0) ∧ (∀(d, e, f)∈set c. d * ((- b' + - 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a'))⇧2 + e * ((- b' + - 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a')) + f ≤ 0) ∧ (∀(d, e, f)∈set d. d * ((- b' + - 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a'))⇧2 + e * ((- b' + - 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a')) + f ≠ 0))" using xis inset by auto then show "False" using f9 by auto qed have r2: "x = (- u + 1 * sqrt (u⇧2 - 4 * t * v)) / (2 * t) ⟹ False" proof - assume xis: "x = (- u + 1 * sqrt (u⇧2 - 4 * t * v)) / (2 * t)" have " t ≠ 0 ∧ - 1*u^2 + 4 * t * v ≤ 0 ∧ (∀(d, e, f)∈set a. d * x⇧2 + e * x + f = 0) ∧ (∀(d, e, f)∈set b. d * x⇧2 + e * x + f < 0) ∧ (∀(d, e, f)∈set c. d * x⇧2 + e * x + f ≤ 0) ∧ (∀(d, e, f)∈set d. d * x⇧2 + e * x + f ≠ 0)" using tnonz alleqset discrh x_prop by auto then have "(∃(a', b', c')∈set c. a' ≠ 0 ∧ - b'⇧2 + 4 * a' * c' ≤ 0 ∧ (∀(d, e, f)∈set a. d * ((- b' + 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a'))⇧2 + e * ((- b' + 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a')) + f = 0) ∧ (∀(d, e, f)∈set b. d * ((- b' + 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a'))⇧2 + e * ((- b' + 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a')) + f < 0) ∧ (∀(d, e, f)∈set c. d * ((- b' + 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a'))⇧2 + e * ((- b' + 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a')) + f ≤ 0) ∧ (∀(d, e, f)∈set d. d * ((- b' + 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a'))⇧2 + e * ((- b' + 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a')) + f ≠ 0))" using xis inset by auto then show "False" using f13 by auto qed then show "False" using r1or2 r1 r2 by auto qed have case2: "(t = 0 ∧ u ≠ 0) ⟹ False" proof - assume asm: "t = 0 ∧ u ≠ 0" then have xis: "x = - v / u" using def_prop notinb add.commute diff_0 divide_non_zero minus_add_cancel uminus_add_conv_diff by (metis mult_zero_left) have "((t = 0 ∧ u ≠ 0) ∧ (∀(d, e, f)∈set a. d * x⇧2 + e * x + f = 0) ∧ (∀(d, e, f)∈set b. d * x^2 + e * x + f < 0) ∧ (∀(d, e, f)∈set c. d * x^2 + e * x + f ≤ 0) ∧ (∀(d, e, f)∈set d. d * x^2 + e * x + f ≠ 0))" using asm x_prop alleqset by auto then have "(∃(a', b', c')∈set c. (a' = 0 ∧ b' ≠ 0) ∧ (∀(d, e, f)∈set a. d * (- c' / b')⇧2 + e * (- c' / b') + f = 0) ∧ (∀(d, e, f)∈set b. d * (- c' / b')⇧2 + e * (- c' / b') + f < 0) ∧ (∀(d, e, f)∈set c. d * (- c' / b')⇧2 + e * (- c' / b') + f ≤ 0) ∧ (∀(d, e, f)∈set d. d * (- c' / b')⇧2 + e * (- c' / b') + f ≠ 0))" using xis inset by auto then show "False" using f8 by auto qed show "False" using def_prop case1 case2 by auto qed have lengt0: "length ?srl ≥ 1 ⟹ False" proof- assume asm: "length ?srl ≥ 1" (* should violate f1 *) have cases_lt: "x < ?srl ! 0 ⟹ False" proof - assume xlt: "x < ?srl ! 0" have samesign: "∀ (a, b, c) ∈ (set b ∪ set c ∪ set d). (∀y < x. sign_num (a * y⇧2 + b * y + c) = sign_num (a*x^2 + b*x + c))" proof clarsimp fix t u v y assume insetunion: "(t, u, v) ∈ set b ∨ (t, u, v) ∈ set c ∨ (t, u, v) ∈ set d" assume ylt: "y < x" have tuzer: "t = 0 ∧ u = 0 ⟹ sign_num (t * y⇧2 + u * y + v) = sign_num (t * x⇧2 + u * x + v)" unfolding sign_num_def by auto have tunonzer: "t ≠ 0 ∨ u ≠ 0 ⟹ sign_num (t * y⇧2 + u * y + v) = sign_num (t * x⇧2 + u * x + v)" proof - assume tuv_asm: "t≠ 0 ∨ u ≠ 0" have "¬(∃q. q < ?srl ! 0 ∧ t * q⇧2 + u * q + v = 0)" proof clarsimp fix q assume qlt: "q < sorted_nonzero_root_list_set (set b ∪ set c ∪ set d) ! 0" assume "t * q⇧2 + u * q + v = 0" then have qin: "q ∈ {x. ∃(a, b, c)∈set b ∪ set c ∪ set d. (a ≠ 0 ∨ b ≠ 0) ∧ a * x⇧2 + b * x + c = 0}" using insetunion tuv_asm by auto have "set ?srl = nonzero_root_set (set b ∪ set c ∪ set d)" unfolding sorted_nonzero_root_list_set_def using set_sorted_list_of_set[of "nonzero_root_set (set b ∪ set c ∪ set d)"] nonzero_root_set_finite[of "(set b ∪ set c ∪ set d)"] by auto then have "q ∈ set ?srl" using qin unfolding nonzero_root_set_def by auto then have lm: "List.member ?srl q" using in_set_member[of q ?srl] by auto then have " List.member (sorted_list_of_set (nonzero_root_set (set b ∪ set c ∪ set d))) q ⟹ q < sorted_list_of_set (nonzero_root_set (set b ∪ set c ∪ set d)) ! 0 ⟹ (⋀x xs. (x ∈ set xs) = (∃i<length xs. xs ! i = x)) ⟹ (⋀x xs. (x ∈ set xs) = List.member xs x) ⟹ (⋀y x. ¬ y ≤ x ⟹ x < y) ⟹ (⋀xs. sorted xs = (∀i j. i ≤ j ⟶ j < length xs ⟶ xs ! i ≤ xs ! j)) ⟹ (⋀p. sorted_nonzero_root_list_set p ≡ sorted_list_of_set (nonzero_root_set p)) ⟹ False" proof - assume a1: "List.member (sorted_list_of_set (nonzero_root_set (set b ∪ set c ∪ set d))) q" assume a2: "q < sorted_list_of_set (nonzero_root_set (set b ∪ set c ∪ set d)) ! 0" have f3: "List.member (sorted_list_of_set {r. ∃p. p ∈ set b ∪ set c ∪ set d ∧ (case p of (ra, rb, rc) ⇒ (ra ≠ 0 ∨ rb ≠ 0) ∧ ra * r⇧2 + rb * r + rc = 0)}) q" using a1 by (metis nonzero_root_set_def) have f4: "q < sorted_list_of_set {r. ∃p. p ∈ set b ∪ set c ∪ set d ∧ (case p of (ra, rb, rc) ⇒ (ra ≠ 0 ∨ rb ≠ 0) ∧ ra * r⇧2 + rb * r + rc = 0)} ! 0" using a2 by (metis nonzero_root_set_def) have f5: "q ∈ set (sorted_list_of_set {r. ∃p. p ∈ set b ∪ set c ∪ set d ∧ (case p of (ra, rb, rc) ⇒ (ra ≠ 0 ∨ rb ≠ 0) ∧ ra * r⇧2 + rb * r + rc = 0)})" using f3 by (meson in_set_member) have "∀rs r. ∃n. ((r::real) ∉ set rs ∨ n < length rs) ∧ (r ∉ set rs ∨ rs ! n = r)" by (metis in_set_conv_nth) then obtain nn :: "real list ⇒ real ⇒ nat" where f6: "⋀r rs. (r ∉ set rs ∨ nn rs r < length rs) ∧ (r ∉ set rs ∨ rs ! nn rs r = r)" by moura then have "sorted_list_of_set {r. ∃p. p ∈ set b ∪ set c ∪ set d ∧ (case p of (ra, rb, rc) ⇒ (ra ≠ 0 ∨ rb ≠ 0) ∧ ra * r⇧2 + rb * r + rc = 0)} ! nn (sorted_list_of_set {r. ∃p. p ∈ set b ∪ set c ∪ set d ∧ (case p of (ra, rb, rc) ⇒ (ra ≠ 0 ∨ rb ≠ 0) ∧ ra * r⇧2 + rb * r + rc = 0)}) q = q" using f5 by blast then have "⋀n. ¬ sorted (sorted_list_of_set {r. ∃p. p ∈ set b ∪ set c ∪ set d ∧ (case p of (ra, rb, rc) ⇒ (ra ≠ 0 ∨ rb ≠ 0) ∧ ra * r⇧2 + rb * r + rc = 0)}) ∨ ¬ n ≤ nn (sorted_list_of_set {r. ∃p. p ∈ set b ∪ set c ∪ set d ∧ (case p of (ra, rb, rc) ⇒ (ra ≠ 0 ∨ rb ≠ 0) ∧ ra * r⇧2 + rb * r + rc = 0)}) q ∨ ¬ nn (sorted_list_of_set {r. ∃p. p ∈ set b ∪ set c ∪ set d ∧ (case p of (ra, rb, rc) ⇒ (ra ≠ 0 ∨ rb ≠ 0) ∧ ra * r⇧2 + rb * r + rc = 0)}) q < length (sorted_list_of_set {r. ∃p. p ∈ set b ∪ set c ∪ set d ∧ (case p of (ra, rb, rc) ⇒ (ra ≠ 0 ∨ rb ≠ 0) ∧ ra * r⇧2 + rb * r + rc = 0)}) ∨ sorted_list_of_set {r. ∃p. p ∈ set b ∪ set c ∪ set d ∧ (case p of (ra, rb, rc) ⇒ (ra ≠ 0 ∨ rb ≠ 0) ∧ ra * r⇧2 + rb * r + rc = 0)} ! n ≤ q" using not_less not_less0 sorted_iff_nth_mono by (metis (no_types, lifting)) then show ?thesis using f6 f5 f4 by (meson le0 not_less sorted_sorted_list_of_set) qed then show "False" using lm qlt in_set_conv_nth in_set_member not_le_imp_less not_less0 sorted_iff_nth_mono sorted_nonzero_root_list_set_def sorted_sorted_list_of_set by auto qed then have "¬(∃q. q ≤ x ∧ t * q⇧2 + u * q + v = 0)" using xlt by auto then show " sign_num (t * y⇧2 + u * y + v) = sign_num (t * x⇧2 + u * x + v)" using ylt changes_sign_var[of t y u v x] by blast qed then show " sign_num (t * y⇧2 + u * y + v) = sign_num (t * x⇧2 + u * x + v)" using tuzer by blast qed have bseth: "(∀(a, b, c)∈set b. ∀y<x. a * y⇧2 + b * y + c < 0)" proof clarsimp fix t u v y assume insetb: "(t, u, v) ∈ set b" assume yltx: "y < x" have "(t, u, v) ∈ (set b ∪ set c ∪ set d)" using insetb by auto then have samesn: "sign_num (t * y⇧2 + u * y + v) = sign_num (t * x⇧2 + u * x + v)" using samesign insetb yltx by blast have "sign_num (t*x^2 + u*x + v) = -1" using x_prop insetb unfolding sign_num_def by auto then show "t * y⇧2 + u * y + v < 0" using samesn unfolding sign_num_def by (metis add.right_inverse add.right_neutral linorder_neqE_linordered_idom one_add_one zero_neq_numeral) qed have bset: " (∀(a, b, c)∈set b. ∃x. ∀y<x. a * y⇧2 + b * y + c < 0)" proof clarsimp fix t u v assume inset: "(t, u, v) ∈ set b" then have " ∀y<x. t * y⇧2 + u * y + v < 0 " using bseth by auto then show "∃x. ∀y<x. t * y⇧2 + u * y + v < 0" by auto qed have cseth: "(∀(a, b, c)∈set c. ∀y<x. a * y⇧2 + b * y + c ≤ 0)" proof clarsimp fix t u v y assume insetc: "(t, u, v) ∈ set c" assume yltx: "y < x" have "(t, u, v) ∈ (set b ∪ set c ∪ set d)" using insetc by auto then have samesn: "sign_num (t * y⇧2 + u * y + v) = sign_num (t * x⇧2 + u * x + v)" using samesign insetc yltx by blast have "sign_num (t*x^2 + u*x + v) = -1 ∨ sign_num (t*x^2 + u*x + v) = 0" using x_prop insetc unfolding sign_num_def by auto then show "t * y⇧2 + u * y + v ≤ 0" using samesn unfolding sign_num_def using zero_neq_one by fastforce qed have cset: " (∀(a, b, c)∈set c. ∃x. ∀y<x. a * y⇧2 + b * y + c ≤ 0)" proof clarsimp fix t u v assume inset: "(t, u, v) ∈ set c" then have " ∀y<x. t * y⇧2 + u * y + v ≤ 0 " using cseth by auto then show "∃x. ∀y<x. t * y⇧2 + u * y + v ≤0" by auto qed have dseth: "(∀(a, b, c)∈set d. ∀y<x. a * y⇧2 + b * y + c ≠ 0)" proof clarsimp fix t u v y assume insetd: "(t, u, v) ∈ set d" assume yltx: "y < x" assume contrad: "t * y⇧2 + u * y + v = 0" have "(t, u, v) ∈ (set b ∪ set c ∪ set d)" using insetd by auto then have samesn: "sign_num (t * y⇧2 + u * y + v) = sign_num (t * x⇧2 + u * x + v)" using samesign insetd yltx by blast have "sign_num (t*x^2 + u*x + v) = -1 ∨ sign_num (t*x^2 + u*x + v) = 1" using x_prop insetd unfolding sign_num_def by auto then have "t * y⇧2 + u * y + v ≠ 0" using samesn unfolding sign_num_def by auto then show "False" using contrad by auto qed have dset: " (∀(a, b, c)∈set d. ∃x. ∀y<x. a * y⇧2 + b * y + c ≠ 0)" proof clarsimp fix t u v assume inset: "(t, u, v) ∈ set d" then have " ∀y<x. t * y⇧2 + u * y + v ≠ 0 " using dseth by auto then show "∃x. ∀y<x. t * y⇧2 + u * y + v ≠ 0" by auto qed have "(∀(a, b, c)∈set a. a = 0 ∧ b = 0 ∧ c = 0)" using alleqsetvar by auto then have "((∀(a, b, c)∈set a. a = 0 ∧ b = 0 ∧ c = 0) ∧ (∀(a, b, c)∈set b. ∃x. ∀y<x. a * y⇧2 + b * y + c < 0) ∧ (∀(a, b, c)∈set c. ∃x. ∀y<x. a * y⇧2 + b * y + c ≤ 0) ∧ (∀(a, b, c)∈set d. ∃x. ∀y<x. a * y⇧2 + b * y + c ≠ 0))" using bset cset dset by auto then show "False" using f1 by auto qed (* should violate one of the infinitesmials *) have cases_gt: " x > ?srl ! (length ?srl - 1) ⟹ False" proof - assume xgt: "x > ?srl ! (length ?srl - 1)" let ?bgrt = "?srl ! (length ?srl - 1)" have samesign: "∀ (a, b, c) ∈ (set b ∪ set c ∪ set d). (∀y > ?bgrt. sign_num (a * y⇧2 + b * y + c) = sign_num (a*x^2 + b*x + c))" proof clarsimp fix t u v y assume insetunion: "(t, u, v) ∈ set b ∨ (t, u, v) ∈ set c ∨ (t, u, v) ∈ set d" assume ygt: "sorted_nonzero_root_list_set (set b ∪ set c ∪ set d) ! (length (sorted_nonzero_root_list_set (set b ∪ set c ∪ set d)) - Suc 0) < y" have tuzer: "t = 0 ∧ u = 0 ⟹ sign_num (t * y⇧2 + u * y + v) = sign_num (t * x⇧2 + u * x + v)" unfolding sign_num_def by auto have tunonzer: "t ≠ 0 ∨ u ≠ 0 ⟹ sign_num (t * y⇧2 + u * y + v) = sign_num (t * x⇧2 + u * x + v)" proof - assume tuv_asm: "t≠ 0 ∨ u ≠ 0" have "¬(∃q. q > ?srl ! (length ?srl - 1) ∧ t * q⇧2 + u * q + v = 0)" proof clarsimp fix q assume qgt: "sorted_nonzero_root_list_set (set b ∪ set c ∪ set d) ! (length (sorted_nonzero_root_list_set (set b ∪ set c ∪ set d)) - Suc 0) < q" assume "t * q⇧2 + u * q + v = 0" then have qin: "q ∈ {x. ∃(a, b, c)∈set b ∪ set c ∪ set d. (a ≠ 0 ∨ b ≠ 0) ∧ a * x⇧2 + b * x + c = 0}" using insetunion tuv_asm by auto have "set ?srl = nonzero_root_set (set b ∪ set c ∪ set d)" unfolding sorted_nonzero_root_list_set_def using set_sorted_list_of_set[of "nonzero_root_set (set b ∪ set c ∪ set d)"] nonzero_root_set_finite[of "(set b ∪ set c ∪ set d)"] by auto then have "q ∈ set ?srl" using qin unfolding nonzero_root_set_def by auto then have "List.member ?srl q" using in_set_member[of q ?srl] by auto then show "False" using qgt in_set_conv_nth in_set_member not_le_imp_less not_less0 sorted_iff_nth_mono sorted_nonzero_root_list_set_def sorted_sorted_list_of_set by (smt (z3) Suc_diff_Suc Suc_n_not_le_n ‹q ∈ set (sorted_nonzero_root_list_set (set b ∪ set c ∪ set d))› in_set_conv_nth length_0_conv length_greater_0_conv length_sorted_list_of_set lenzero less_Suc_eq_le minus_nat.diff_0 not_le sorted_nth_mono sorted_sorted_list_of_set) qed then have nor: "¬(∃q. q > ?bgrt ∧ t * q⇧2 + u * q + v = 0)" using xgt by auto have c1: " x > y ⟹ sign_num (t * y⇧2 + u * y + v) = sign_num (t * x⇧2 + u * x + v)" using nor changes_sign_var[of t y u v x] xgt ygt by fastforce then have c2: " y > x ⟹ sign_num (t * y⇧2 + u * y + v) = sign_num (t * x⇧2 + u * x + v)" using nor changes_sign_var[of t x u v y] xgt ygt by force then have c3: " x = y ⟹ sign_num (t * y⇧2 + u * y + v) = sign_num (t * x⇧2 + u * x + v)" unfolding sign_num_def by auto then show "sign_num (t * y⇧2 + u * y + v) = sign_num (t * x⇧2 + u * x + v)" using c1 c2 c3 by linarith qed then show " sign_num (t * y⇧2 + u * y + v) = sign_num (t * x⇧2 + u * x + v)" using tuzer by blast qed have "(∀(a, b, c)∈set a. a = 0 ∧ b = 0 ∧ c = 0)" using alleqsetvar by auto have " ?bgrt ∈ set ?srl" using set_sorted_list_of_set nonzero_root_set_finite in_set_member using asm by auto then have "?bgrt ∈ nonzero_root_set (set b ∪ set c ∪ set d )" unfolding sorted_nonzero_root_list_set_def using set_sorted_list_of_set nonzero_root_set_finite by auto then have "∃t u v. (t, u, v) ∈ set b ∪ set c ∪ set d ∧(t ≠ 0 ∨ u ≠ 0) ∧ (t * ?bgrt⇧2 + u * ?bgrt + v = 0)" unfolding nonzero_root_set_def by auto then obtain t u v where tuvprop1: "(t, u, v) ∈ set b ∪ set c ∪ set d ∧(t ≠ 0 ∨ u ≠ 0) ∧ (t * ?bgrt⇧2 + u * ?bgrt + v = 0)" by auto then have tuvprop: "((t, u, v) ∈ set b ∧ (t ≠ 0 ∨ u ≠ 0) ∧ (t * ?bgrt⇧2 + u * ?bgrt + v = 0)) ∨ ((t, u, v) ∈ set c ∧ (t ≠ 0 ∨ u ≠ 0) ∧ (t * ?bgrt⇧2 + u * ?bgrt + v = 0)) ∨ ((t, u, v) ∈ set d ∧ (t ≠ 0 ∨ u ≠ 0) ∧ (t * ?bgrt⇧2 + u * ?bgrt + v = 0)) " by auto have tnonz: "t≠ 0 ⟹ (-1*u^2 + 4 * t * v ≤ 0 ∧ (?bgrt = (- u + 1 * sqrt (u^2 - 4 * t * v)) / (2 * t) ∨ ?bgrt = (- u + -1 * sqrt (u^2 - 4 * t * v)) / (2 * t)))" proof - assume "t≠ 0" have "-1*u^2 + 4 * t * v ≤ 0 " using tuvprop1 discriminant_negative[of t u v] unfolding discrim_def using ‹t ≠ 0› by force then show ?thesis using tuvprop discriminant_nonneg[of t u v] unfolding discrim_def using ‹t ≠ 0› by auto qed have unonz: "(t = 0 ∧ u ≠ 0) ⟹ ?bgrt = - v / u" proof - assume "(t = 0 ∧ u ≠ 0)" then have "u*?bgrt + v = 0" using tuvprop1 by simp then show "?bgrt = - v / u" by (simp add: ‹t = 0 ∧ u ≠ 0› eq_minus_divide_eq mult.commute) qed have allpropb: "(∀(d, e, f)∈set b. ∀y'>?bgrt. ∀x∈{?bgrt<..y'}. d * x⇧2 + e * x + f < 0)" proof clarsimp fix t1 u1 v1 y1 x1 assume ins: "(t1, u1, v1) ∈ set b" assume x1gt: " sorted_nonzero_root_list_set (set b ∪ set c ∪ set d) ! (length (sorted_nonzero_root_list_set (set b ∪ set c ∪ set d)) - Suc 0) < x1" assume "x1 ≤ y1" have xsn: "sign_num (t1 * x^2 + u1 * x + v1 ) = -1" using ins x_prop unfolding sign_num_def by auto have "sign_num (t1 * x1⇧2 + u1 * x1 + v1 ) = sign_num (t1 * x^2 + u1 * x + v1 ) " using ins x1gt samesign apply (auto) by blast then show "t1 * x1⇧2 + u1 * x1 + v1 < 0" using xsn unfolding sign_num_def by (metis add.right_inverse add.right_neutral linorder_neqE_linordered_idom one_add_one zero_neq_numeral) qed have allpropbvar: "(∀(d, e, f)∈set b. ∃y'>?bgrt. ∀x∈{?bgrt<..y'}. d * x⇧2 + e * x + f < 0)" proof clarsimp fix t1 u1 v1 assume "(t1, u1, v1) ∈ set b" then have "∀x∈{?bgrt<..(?bgrt + 1)}. t1 * x⇧2 + u1 * x + v1 < 0" using allpropb by force then show "∃y'>sorted_nonzero_root_list_set (set b ∪ set c ∪ set d) ! (length (sorted_nonzero_root_list_set (set b ∪ set c ∪ set d)) - Suc 0). ∀x∈{sorted_nonzero_root_list_set (set b ∪ set c ∪ set d) ! (length (sorted_nonzero_root_list_set (set b ∪ set c ∪ set d)) - Suc 0)<..y'}. t1 * x⇧2 + u1 * x + v1 < 0" using less_add_one by (metis One_nat_def) qed have allpropc: "(∀(d, e, f)∈set c. ∀y'>?bgrt. ∀x∈{?bgrt<..y'}. d * x⇧2 + e * x + f ≤ 0)" proof clarsimp fix t1 u1 v1 y1 x1 assume ins: "(t1, u1, v1) ∈ set c" assume x1gt: " sorted_nonzero_root_list_set (set b ∪ set c ∪ set d) ! (length (sorted_nonzero_root_list_set (set b ∪ set c ∪ set d)) - Suc 0) < x1" assume "x1 ≤ y1" have xsn: "sign_num (t1 * x^2 + u1 * x + v1 ) = -1 ∨ sign_num (t1 * x^2 + u1 * x + v1 ) = 0" using ins x_prop unfolding sign_num_def by auto have "sign_num (t1 * x1⇧2 + u1 * x1 + v1 ) = sign_num (t1 * x^2 + u1 * x + v1 ) " using ins x1gt samesign One_nat_def proof - have "case (t1, u1, v1) of (r, ra, rb) ⇒ ∀raa>sorted_nonzero_root_list_set (set b ∪ set c ∪ set d) ! (length (sorted_nonzero_root_list_set (set b ∪ set c ∪ set d)) - 1). sign_num (r * raa⇧2 + ra * raa + rb) = sign_num (r * x⇧2 + ra * x + rb)" by (smt (z3) Un_iff ins samesign) then show ?thesis by (simp add: x1gt) qed then show "t1 * x1⇧2 + u1 * x1 + v1 ≤ 0" using xsn unfolding sign_num_def by (metis equal_neg_zero less_numeral_extra(3) linorder_not_less zero_neq_one) qed have allpropcvar: "(∀(d, e, f)∈set c. ∃y'>?bgrt. ∀x∈{?bgrt<..y'}. d * x⇧2 + e * x + f ≤ 0)" proof clarsimp fix t1 u1 v1 assume "(t1, u1, v1) ∈ set c" then have "∀x∈{?bgrt<..(?bgrt + 1)}. t1 * x⇧2 + u1 * x + v1 ≤ 0" using allpropc by force then show "∃y'>sorted_nonzero_root_list_set (set b ∪ set c ∪ set d) ! (length (sorted_nonzero_root_list_set (set b ∪ set c ∪ set d)) - Suc 0). ∀x∈{sorted_nonzero_root_list_set (set b ∪ set c ∪ set d) ! (length (sorted_nonzero_root_list_set (set b ∪ set c ∪ set d)) - Suc 0)<..y'}. t1 * x⇧2 + u1 * x + v1 ≤ 0" using less_add_one One_nat_def by (metis (no_types, hide_lams)) qed have allpropd: "(∀(d, e, f)∈set d. ∀y'>?bgrt. ∀x∈{?bgrt<..y'}. d * x⇧2 + e * x + f ≠ 0)" proof clarsimp fix t1 u1 v1 y1 x1 assume ins: "(t1, u1, v1) ∈ set d" assume contrad:"t1 * x1⇧2 + u1 * x1 + v1 = 0" assume x1gt: " sorted_nonzero_root_list_set (set b ∪ set c ∪ set d) ! (length (sorted_nonzero_root_list_set (set b ∪ set c ∪ set d)) - Suc 0) < x1" assume "x1 ≤ y1" have xsn: "sign_num (t1 * x^2 + u1 * x + v1 ) = -1 ∨ sign_num (t1 * x^2 + u1 * x + v1 ) = 1" using ins x_prop unfolding sign_num_def by auto have "sign_num (t1 * x1⇧2 + u1 * x1 + v1 ) = sign_num (t1 * x^2 + u1 * x + v1 ) " using ins x1gt samesign apply (auto) by blast then have "t1 * x1⇧2 + u1 * x1 + v1 ≠ 0" using xsn unfolding sign_num_def by auto then show "False" using contrad by auto qed have allpropdvar: "(∀(d, e, f)∈set d. ∃y'>?bgrt. ∀x∈{?bgrt<..y'}. d * x⇧2 + e * x + f ≠ 0)" proof clarsimp fix t1 u1 v1 assume "(t1, u1, v1) ∈ set d" then have "∀x∈{?bgrt<..(?bgrt + 1)}. t1 * x⇧2 + u1 * x + v1 ≠ 0" using allpropd by force then show "∃y'>sorted_nonzero_root_list_set (set b ∪ set c ∪ set d) ! (length (sorted_nonzero_root_list_set (set b ∪ set c ∪ set d)) - Suc 0). ∀x∈{sorted_nonzero_root_list_set (set b ∪ set c ∪ set d) ! (length (sorted_nonzero_root_list_set (set b ∪ set c ∪ set d)) - Suc 0)<..y'}. t1 * x⇧2 + u1 * x + v1 ≠ 0" using less_add_one by (metis (no_types, hide_lams) One_nat_def) qed have "∀x. (∀(d, e, f)∈set a. d * x⇧2 + e * x + f = 0)" using alleqsetvar by auto then have ast: "(∀(d, e, f)∈set a. ∀x∈{?bgrt<..(?bgrt + 1)}. d * x⇧2 + e * x + f = 0)" by auto have allpropavar: "(∀(d, e, f)∈set a. ∃y'>?bgrt. ∀x∈{?bgrt<..y'}. d * x⇧2 + e * x + f = 0)" proof clarsimp fix t1 u1 v1 assume "(t1, u1, v1) ∈ set a" then have "∀x∈{?bgrt<..(?bgrt + 1)}. t1 * x⇧2 + u1 * x + v1 = 0 " using ast by auto then show "∃y'>sorted_nonzero_root_list_set (set b ∪ set c ∪ set d) ! (length (sorted_nonzero_root_list_set (set b ∪ set c ∪ set d)) - Suc 0). ∀x∈{sorted_nonzero_root_list_set (set b ∪ set c ∪ set d) ! (length (sorted_nonzero_root_list_set (set b ∪ set c ∪ set d)) - Suc 0)<..y'}. t1 * x⇧2 + u1 * x + v1 = 0" using less_add_one One_nat_def by metis qed have quadsetb: "((t, u, v) ∈ set b ∧ t≠ 0) ⟹ False" proof - assume asm: "(t, u, v) ∈ set b ∧ t≠ 0" have bgrt1: "(?bgrt = (- u + 1 * sqrt (u^2 - 4 * t * v)) / (2 * t)) ⟹ False " proof - assume bgrtis: "?bgrt = (- u + 1 * sqrt (u^2 - 4 * t * v)) / (2 * t)" have discrim_prop: "-1*u^2 + 4 * t * v ≤ 0" using asm tnonz using ‹sorted_nonzero_root_list_set (set b ∪ set c ∪ set d) ! (length (sorted_nonzero_root_list_set (set b ∪ set c ∪ set d)) - 1) = (- u + 1 * sqrt (u⇧2 - 4 * t * v)) / (2 * t)› by auto have "((t, u, v)∈set b ∧ t ≠ 0 ∧ - 1*u^2 + 4 * t * v ≤ 0 ∧ ((∀(d, e, f)∈set a. ∃y'>?bgrt. ∀x∈{?bgrt<..y'}. d * x⇧2 + e * x + f = 0) ∧ (∀(d, e, f)∈set b. ∃y'>?bgrt. ∀x∈{?bgrt<..y'}. d * x⇧2 + e * x + f < 0) ∧ (∀(d, e, f)∈set c. ∃y'>?bgrt. ∀x∈{?bgrt<..y'}. d * x⇧2 + e * x + f ≤ 0) ∧ (∀(d, e, f)∈set d. ∃y'>?bgrt. ∀x∈{?bgrt<..y'}. d * x⇧2 + e * x + f ≠ 0)))" using asm discrim_prop allpropavar allpropbvar allpropcvar allpropdvar by linarith then show "False" using f6 bgrtis by auto qed have bgrt2: "(?bgrt = (- u + -1 * sqrt (u^2 - 4 * t * v)) / (2 * t)) ⟹ False " proof - assume bgrtis: "?bgrt = (- u + -1 * sqrt (u^2 - 4 * t * v)) / (2 * t)" have discrim_prop: "-1*u^2 + 4 * t * v ≤ 0" using asm tnonz using ‹sorted_nonzero_root_list_set (set b ∪ set c ∪ set d) ! (length (sorted_nonzero_root_list_set (set b ∪ set c ∪ set d)) - 1) = (- u + -1 * sqrt (u⇧2 - 4 * t * v)) / (2 * t)› by auto have "((t, u, v)∈set b ∧ t ≠ 0 ∧ - 1*u^2 + 4 * t * v ≤ 0 ∧ ((∀(d, e, f)∈set a. ∃y'>?bgrt. ∀x∈{?bgrt<..y'}. d * x⇧2 + e * x + f = 0) ∧ (∀(d, e, f)∈set b. ∃y'>?bgrt. ∀x∈{?bgrt<..y'}. d * x⇧2 + e * x + f < 0) ∧ (∀(d, e, f)∈set c. ∃y'>?bgrt. ∀x∈{?bgrt<..y'}. d * x⇧2 + e * x + f ≤ 0) ∧ (∀(d, e, f)∈set d. ∃y'>?bgrt. ∀x∈{?bgrt<..y'}. d * x⇧2 + e * x + f ≠ 0)))" using asm discrim_prop allpropavar allpropbvar allpropcvar allpropdvar by linarith then show "False" using f7 bgrtis by auto qed show "False" using tnonz bgrt1 bgrt2 asm by auto qed have linsetb: "((t, u, v) ∈ set b ∧ (t = 0 ∧ u ≠ 0)) ⟹ False" proof - assume asm: "(t, u, v) ∈ set b ∧ (t = 0 ∧ u ≠ 0)" then have bgrtis: "?bgrt = (- v / u)" using unonz by blast have "((t, u, v)∈set b ∧ (t = 0 ∧ u ≠ 0) ∧ ((∀(d, e, f)∈set a. ∃y'>?bgrt. ∀x∈{?bgrt<..y'}. d * x⇧2 + e * x + f = 0) ∧ (∀(d, e, f)∈set b. ∃y'>?bgrt. ∀x∈{?bgrt<..y'}. d * x⇧2 + e * x + f < 0) ∧ (∀(d, e, f)∈set c. ∃y'>?bgrt. ∀x∈{?bgrt<..y'}. d * x⇧2 + e * x + f ≤ 0) ∧ (∀(d, e, f)∈set d. ∃y'>?bgrt. ∀x∈{?bgrt<..y'}. d * x⇧2 + e * x + f ≠ 0)))" using asm allpropavar allpropbvar allpropcvar allpropdvar by linarith then show "False" using bgrtis f5 by auto qed have insetb: "((t, u, v) ∈ set b ∧ (t ≠ 0 ∨ u ≠ 0) ∧ (t * ?bgrt⇧2 + u * ?bgrt + v = 0)) ⟹ False" using quadsetb linsetb by auto have quadsetc: "(t, u, v) ∈ set c ∧ t≠ 0 ⟹ False" proof - assume asm: "(t, u, v) ∈ set c ∧ t≠ 0" have bgrt1: "(?bgrt = (- u + 1 * sqrt (u^2 - 4 * t * v)) / (2 * t)) ⟹ False " proof - assume bgrtis: "?bgrt = (- u + 1 * sqrt (u^2 - 4 * t * v)) / (2 * t)" have discrim_prop: "-1*u^2 + 4 * t * v ≤ 0" using asm tnonz using ‹sorted_nonzero_root_list_set (set b ∪ set c ∪ set d) ! (length (sorted_nonzero_root_list_set (set b ∪ set c ∪ set d)) - 1) = (- u + 1 * sqrt (u⇧2 - 4 * t * v)) / (2 * t)› by auto have "((t, u, v)∈set c ∧ t ≠ 0 ∧ - 1*u^2 + 4 * t * v ≤ 0 ∧ ((∀(d, e, f)∈set a. ∃y'>?bgrt. ∀x∈{?bgrt<..y'}. d * x⇧2 + e * x + f = 0) ∧ (∀(d, e, f)∈set b. ∃y'>?bgrt. ∀x∈{?bgrt<..y'}. d * x⇧2 + e * x + f < 0) ∧ (∀(d, e, f)∈set c. ∃y'>?bgrt. ∀x∈{?bgrt<..y'}. d * x⇧2 + e * x + f ≤ 0) ∧ (∀(d, e, f)∈set d. ∃y'>?bgrt. ∀x∈{?bgrt<..y'}. d * x⇧2 + e * x + f ≠ 0)))" using asm discrim_prop allpropavar allpropbvar allpropcvar allpropdvar by linarith then show "False" using f13a bgrtis by auto qed have bgrt2: "(?bgrt = (- u + -1 * sqrt (u^2 - 4 * t * v)) / (2 * t)) ⟹ False " proof - assume bgrtis: "?bgrt = (- u + -1 * sqrt (u^2 - 4 * t * v)) / (2 * t)" have discrim_prop: "-1*u^2 + 4 * t * v ≤ 0" using asm tnonz using ‹sorted_nonzero_root_list_set (set b ∪ set c ∪ set d) ! (length (sorted_nonzero_root_list_set (set b ∪ set c ∪ set d)) - 1) = (- u + -1 * sqrt (u⇧2 - 4 * t * v)) / (2 * t)› by auto have "((t, u, v)∈set c ∧ t ≠ 0 ∧ - 1*u^2 + 4 * t * v ≤ 0 ∧ ((∀(d, e, f)∈set a. ∃y'>?bgrt. ∀x∈{?bgrt<..y'}. d * x⇧2 + e * x + f = 0) ∧ (∀(d, e, f)∈set b. ∃y'>?bgrt. ∀x∈{?bgrt<..y'}. d * x⇧2 + e * x + f < 0) ∧ (∀(d, e, f)∈set c. ∃y'>?bgrt. ∀x∈{?bgrt<..y'}. d * x⇧2 + e * x + f ≤ 0) ∧ (∀(d, e, f)∈set d. ∃y'>?bgrt. ∀x∈{?bgrt<..y'}. d * x⇧2 + e * x + f ≠ 0)))" using asm discrim_prop allpropavar allpropbvar allpropcvar allpropdvar by linarith then show "False" using f9a bgrtis by auto qed show "False" using tnonz bgrt1 bgrt2 asm by auto qed have linsetc: "(t, u, v) ∈ set c ∧ (t = 0 ∧ u ≠ 0) ⟹ False" proof - assume asm: "(t, u, v) ∈ set c ∧ (t = 0 ∧ u ≠ 0)" then have bgrtis: "?bgrt = (- v / u)" using unonz by blast have "((t, u, v)∈set c ∧ (t = 0 ∧ u ≠ 0) ∧ ((∀(d, e, f)∈set a. ∃y'>?bgrt. ∀x∈{?bgrt<..y'}. d * x⇧2 + e * x + f = 0) ∧ (∀(d, e, f)∈set b. ∃y'>?bgrt. ∀x∈{?bgrt<..y'}. d * x⇧2 + e * x + f < 0) ∧ (∀(d, e, f)∈set c. ∃y'>?bgrt. ∀x∈{?bgrt<..y'}. d * x⇧2 + e * x + f ≤ 0) ∧ (∀(d, e, f)∈set d. ∃y'>?bgrt. ∀x∈{?bgrt<..y'}. d * x⇧2 + e * x + f ≠ 0)))" using asm allpropavar allpropbvar allpropcvar allpropdvar by linarith then show "False" using bgrtis f8a by auto qed have insetc: "((t, u, v) ∈ set c ∧ (t ≠ 0 ∨ u ≠ 0) ∧ (t * ?bgrt⇧2 + u * ?bgrt + v = 0)) ⟹ False" using quadsetc linsetc by auto have quadsetd: "(t, u, v) ∈ set d ∧ t≠ 0 ⟹ False" proof - assume asm: "(t, u, v) ∈ set d ∧ t≠ 0" have bgrt1: "(?bgrt = (- u + 1 * sqrt (u^2 - 4 * t * v)) / (2 * t)) ⟹ False " proof - assume bgrtis: "?bgrt = (- u + 1 * sqrt (u^2 - 4 * t * v)) / (2 * t)" have discrim_prop: "-1*u^2 + 4 * t * v ≤ 0" using asm tnonz using ‹sorted_nonzero_root_list_set (set b ∪ set c ∪ set d) ! (length (sorted_nonzero_root_list_set (set b ∪ set c ∪ set d)) - 1) = (- u + 1 * sqrt (u⇧2 - 4 * t * v)) / (2 * t)› by auto have "((t, u, v)∈set d ∧ t ≠ 0 ∧ - 1*u^2 + 4 * t * v ≤ 0 ∧ ((∀(d, e, f)∈set a. ∃y'>?bgrt. ∀x∈{?bgrt<..y'}. d * x⇧2 + e * x + f = 0) ∧ (∀(d, e, f)∈set b. ∃y'>?bgrt. ∀x∈{?bgrt<..y'}. d * x⇧2 + e * x + f < 0) ∧ (∀(d, e, f)∈set c. ∃y'>?bgrt. ∀x∈{?bgrt<..y'}. d * x⇧2 + e * x + f ≤ 0) ∧ (∀(d, e, f)∈set d. ∃y'>?bgrt. ∀x∈{?bgrt<..y'}. d * x⇧2 + e * x + f ≠ 0)))" using asm discrim_prop allpropavar allpropbvar allpropcvar allpropdvar by linarith then show "False" using f11 bgrtis by auto qed have bgrt2: "(?bgrt = (- u + -1 * sqrt (u^2 - 4 * t * v)) / (2 * t)) ⟹ False " proof - assume bgrtis: "?bgrt = (- u + -1 * sqrt (u^2 - 4 * t * v)) / (2 * t)" have discrim_prop: "-1*u^2 + 4 * t * v ≤ 0" using asm tnonz using ‹sorted_nonzero_root_list_set (set b ∪ set c ∪ set d) ! (length (sorted_nonzero_root_list_set (set b ∪ set c ∪ set d)) - 1) = (- u + -1 * sqrt (u⇧2 - 4 * t * v)) / (2 * t)› by auto have "((t, u, v)∈set d ∧ t ≠ 0 ∧ - 1*u^2 + 4 * t * v ≤ 0 ∧ ((∀(d, e, f)∈set a. ∃y'>?bgrt. ∀x∈{?bgrt<..y'}. d * x⇧2 + e * x + f = 0) ∧ (∀(d, e, f)∈set b. ∃y'>?bgrt. ∀x∈{?bgrt<..y'}. d * x⇧2 + e * x + f < 0) ∧ (∀(d, e, f)∈set c. ∃y'>?bgrt. ∀x∈{?bgrt<..y'}. d * x⇧2 + e * x + f ≤ 0) ∧ (∀(d, e, f)∈set d. ∃y'>?bgrt. ∀x∈{?bgrt<..y'}. d * x⇧2 + e * x + f ≠ 0)))" using asm discrim_prop allpropavar allpropbvar allpropcvar allpropdvar by linarith then show "False" using f12 bgrtis by auto qed show "False" using tnonz bgrt1 bgrt2 asm by auto qed have linsetd: "(t, u, v) ∈ set d ∧ (t = 0 ∧ u ≠ 0) ⟹ False" proof - assume asm: "(t, u, v) ∈ set d ∧ (t = 0 ∧ u ≠ 0)" then have bgrtis: "?bgrt = (- v / u)" using unonz by blast have "((t, u, v)∈set d ∧ (t = 0 ∧ u ≠ 0) ∧ ((∀(d, e, f)∈set a. ∃y'>?bgrt. ∀x∈{?bgrt<..y'}. d * x⇧2 + e * x + f = 0) ∧ (∀(d, e, f)∈set b. ∃y'>?bgrt. ∀x∈{?bgrt<..y'}. d * x⇧2 + e * x + f < 0) ∧ (∀(d, e, f)∈set c. ∃y'>?bgrt. ∀x∈{?bgrt<..y'}. d * x⇧2 + e * x + f ≤ 0) ∧ (∀(d, e, f)∈set d. ∃y'>?bgrt. ∀x∈{?bgrt<..y'}. d * x⇧2 + e * x + f ≠ 0)))" using asm allpropavar allpropbvar allpropcvar allpropdvar by linarith then show "False" using bgrtis f10 by auto qed have insetd: "((t, u, v) ∈ set d ∧ (t ≠ 0 ∨ u ≠ 0) ∧ (t * ?bgrt⇧2 + u * ?bgrt + v = 0)) ⟹ False" using quadsetd linsetd by auto then show "False" using insetb insetc insetd tuvprop by auto qed have len1: "length ?srl = 1 ⟹ False" proof - assume len1: "length ?srl = 1" have cases: "(List.member ?srl x) ∨ x < ?srl ! 0 ∨ x > ?srl ! 0" using in_set_member lenzero nth_mem by fastforce then show "False" using len1 cases_mem cases_lt cases_gt by auto qed have lengtone: "length ?srl > 1 ⟹ False" proof - assume lengt1: "length ?srl > 1" have cases: "(List.member ?srl x) ∨ x < ?srl ! 0 ∨ x > ?srl ! (length ?srl -1) ∨ (∃k ≤ (length ?srl - 2). (?srl ! k < x ∧ x <?srl ! (k + 1)))" proof - have eo: "x < ?srl ! 0 ∨ x > ?srl ! (length ?srl -1) ∨ (x ≥ ?srl ! 0 ∧ x ≤ ?srl ! (length ?srl -1))" by auto have ifo: "(x ≥ ?srl ! 0 ∧ x ≤ ?srl ! (length ?srl -1)) ⟹ ((List.member ?srl x) ∨ (∃k ≤ (length ?srl - 2). ?srl ! k < x ∧ x <?srl ! (k + 1)))" proof - assume xinbtw: "x ≥ ?srl ! 0 ∧ x ≤ ?srl ! (length ?srl -1)" then have "¬(List.member ?srl x) ⟹ (∃k ≤ (length ?srl - 2). ?srl ! k < x ∧ x <?srl ! (k + 1))" proof - assume nonmem: "¬(List.member ?srl x)" have "¬(∃k ≤ (length ?srl - 2). ?srl ! k < x ∧ x <?srl ! (k + 1)) ⟹ False" proof clarsimp assume "∀k. sorted_nonzero_root_list_set (set b ∪ set c ∪ set d) ! k < x ⟶ k ≤ length (sorted_nonzero_root_list_set (set b ∪ set c ∪ set d)) - 2 ⟶ ¬ x < sorted_nonzero_root_list_set (set b ∪ set c ∪ set d) ! Suc k" then have allk: "(∀k ≤ length ?srl - 2. ?srl ! k < x ⟶ ¬ x < ?srl ! Suc k)" by auto have basec: "x ≥ ?srl ! 0" using xinbtw by auto have "∀k ≤ length ?srl - 2. ?srl ! k < x" proof clarsimp fix k assume klteq: "k ≤ length (sorted_nonzero_root_list_set (set b ∪ set c ∪ set d)) - 2" show "sorted_nonzero_root_list_set (set b ∪ set c ∪ set d) ! k < x" using nonmem klteq basec proof (induct k) case 0 then show ?case using in_set_member lenzero nth_mem by fastforce next case (Suc k) then show ?case by (smt Suc_leD Suc_le_lessD ‹∀k. sorted_nonzero_root_list_set (set b ∪ set c ∪ set d) ! k < x ⟶ k ≤ length (sorted_nonzero_root_list_set (set b ∪ set c ∪ set d)) - 2 ⟶ ¬ x < sorted_nonzero_root_list_set (set b ∪ set c ∪ set d) ! Suc k› diff_less in_set_member length_0_conv length_greater_0_conv lenzero less_trans_Suc nth_mem pos2) qed qed then have "x ≥ ?srl ! (length ?srl -1)" using allk by (metis One_nat_def Suc_diff_Suc lengt1 less_eq_real_def less_or_eq_imp_le one_add_one plus_1_eq_Suc xinbtw) then have "x > ?srl ! (length ?srl - 1)" using nonmem by (metis One_nat_def Suc_le_D asm diff_Suc_Suc diff_zero in_set_member lessI less_eq_real_def nth_mem) then show "False" using xinbtw by auto qed then show "(∃k ≤ (length ?srl - 2). ?srl ! k < x ∧ x <?srl ! (k + 1))" by blast qed then show "((List.member ?srl x) ∨ (∃k ≤ (length ?srl - 2). ?srl ! k < x ∧ x <?srl ! (k + 1)))" using sorted_nth_mono by auto qed then show ?thesis using eo ifo by auto qed (* should violate one of the infinitesmials *) have cases_btw: "(∃k ≤ (length ?srl - 2). ?srl ! k < x ∧ x <?srl ! (k + 1)) ⟹ False" proof - assume "(∃k ≤ (length ?srl - 2). ?srl ! k < x ∧ x <?srl ! (k + 1))" then obtain k where k_prop: "k ≤ (length ?srl - 2) ∧ ?srl ! k < x ∧ x <?srl ! (k + 1)" by auto have samesign: "∀ (a, b, c) ∈ (set b ∪ set c ∪ set d). (∀y. (?srl ! k < y ∧ y <?srl ! (k + 1)) ⟶ sign_num (a * y⇧2 + b * y + c) = sign_num (a*x^2 + b*x + c))" proof clarsimp fix t u v y assume insetunion: "(t, u, v) ∈ set b ∨ (t, u, v) ∈ set c ∨ (t, u, v) ∈ set d" assume ygt: " sorted_nonzero_root_list_set (set b ∪ set c ∪ set d) ! k < y" assume ylt: "y < sorted_nonzero_root_list_set (set b ∪ set c ∪ set d) ! Suc k" have tuzer: "t = 0 ∧ u = 0 ⟹ sign_num (t * y⇧2 + u * y + v) = sign_num (t * x⇧2 + u * x + v)" unfolding sign_num_def by auto have tunonzer: "t ≠ 0 ∨ u ≠ 0 ⟹ sign_num (t * y⇧2 + u * y + v) = sign_num (t * x⇧2 + u * x + v)" proof - assume tuv_asm: "t≠ 0 ∨ u ≠ 0" have nor: "¬(∃q. q > ?srl ! k ∧ q < ?srl ! (k + 1) ∧ t * q⇧2 + u * q + v = 0)" proof clarsimp fix q assume qlt: "q < sorted_nonzero_root_list_set (set b ∪ set c ∪ set d) ! Suc k" assume qgt: "sorted_nonzero_root_list_set (set b ∪ set c ∪ set d) ! k < q" assume "t * q⇧2 + u * q + v = 0" then have qin: "q ∈ {x. ∃(a, b, c)∈set b ∪ set c ∪ set d. (a ≠ 0 ∨ b ≠ 0) ∧ a * x⇧2 + b * x + c = 0}" using insetunion tuv_asm by auto have "set ?srl = nonzero_root_set (set b ∪ set c ∪ set d)" unfolding sorted_nonzero_root_list_set_def using set_sorted_list_of_set[of "nonzero_root_set (set b ∪ set c ∪ set d)"] nonzero_root_set_finite[of "(set b ∪ set c ∪ set d)"] by auto then have "q ∈ set ?srl" using qin unfolding nonzero_root_set_def by auto then have "List.member ?srl q" using in_set_member[of q ?srl] by auto then have "∃n < length ?srl. q = ?srl ! n" by (metis ‹q ∈ set (sorted_nonzero_root_list_set (set b ∪ set c ∪ set d))› in_set_conv_nth) then obtain n where nprop: "n < length ?srl ∧ q = ?srl ! n" by auto then have ngtk: "n > k" proof - have sortedh: "sorted ?srl" by (simp add: sorted_nonzero_root_list_set_def) then have nlteq: "n ≤ k ⟹ ?srl ! n ≤ ?srl ! k" using nprop k_prop sorted_iff_nth_mono using sorted_nth_mono by (metis (no_types, hide_lams) Suc_1 ‹q ∈ set (sorted_nonzero_root_list_set (set b ∪ set c ∪ set d))› diff_Suc_less length_pos_if_in_set sup.absorb_iff2 sup.strict_boundedE) have "?srl ! n > ?srl ! k" using nprop qgt by auto then show ?thesis using nlteq by linarith qed then have nltkp1: "n < k+1" proof - have sortedh: "sorted ?srl" by (simp add: sorted_nonzero_root_list_set_def) then have ngteq: "k+1 ≤ n ⟹ ?srl ! (k+1) ≤ ?srl ! n" using nprop k_prop sorted_iff_nth_mono by auto have "?srl ! n < ?srl ! (k + 1)" using nprop qlt by auto then show ?thesis using ngteq by linarith qed then show "False" using ngtk nltkp1 by auto qed have c1: " x > y ⟹ sign_num (t * y⇧2 + u * y + v) = sign_num (t * x⇧2 + u * x + v)" using nor changes_sign_var[of t y u v x] k_prop ygt ylt by fastforce then have c2: " y > x ⟹ sign_num (t * y⇧2 + u * y + v) = sign_num (t * x⇧2 + u * x + v)" using nor changes_sign_var[of t x u v y] k_prop ygt ylt by force then have c3: " x = y ⟹ sign_num (t * y⇧2 + u * y + v) = sign_num (t * x⇧2 + u * x + v)" unfolding sign_num_def by auto then show "sign_num (t * y⇧2 + u * y + v) = sign_num (t * x⇧2 + u * x + v)" using c1 c2 c3 by linarith qed then show " sign_num (t * y⇧2 + u * y + v) = sign_num (t * x⇧2 + u * x + v)" using tuzer by blast qed let ?bgrt = "?srl ! k" have "(∀(a, b, c)∈set a. a = 0 ∧ b = 0 ∧ c = 0)" using alleqsetvar by auto have " ?bgrt ∈ set ?srl" using set_sorted_list_of_set nonzero_root_set_finite in_set_member k_prop asm by (smt diff_Suc_less le_eq_less_or_eq less_le_trans nth_mem one_add_one plus_1_eq_Suc zero_less_one) then have "?bgrt ∈ nonzero_root_set (set b ∪ set c ∪ set d )" unfolding sorted_nonzero_root_list_set_def using set_sorted_list_of_set nonzero_root_set_finite by auto then have "∃t u v. (t, u, v) ∈ set b ∪ set c ∪ set d ∧(t ≠ 0 ∨ u ≠ 0) ∧ (t * ?bgrt⇧2 + u * ?bgrt + v = 0)" unfolding nonzero_root_set_def by auto then obtain t u v where tuvprop1: "(t, u, v) ∈ set b ∪ set c ∪ set d ∧(t ≠ 0 ∨ u ≠ 0) ∧ (t * ?bgrt⇧2 + u * ?bgrt + v = 0)" by auto then have tuvprop: "((t, u, v) ∈ set b ∧ (t ≠ 0 ∨ u ≠ 0) ∧ (t * ?bgrt⇧2 + u * ?bgrt + v = 0)) ∨ ((t, u, v) ∈ set c ∧ (t ≠ 0 ∨ u ≠ 0) ∧ (t * ?bgrt⇧2 + u * ?bgrt + v = 0)) ∨ ((t, u, v) ∈ set d ∧ (t ≠ 0 ∨ u ≠ 0) ∧ (t * ?bgrt⇧2 + u * ?bgrt + v = 0)) " by auto have tnonz: "t≠ 0 ⟹ (-1*u^2 + 4 * t * v ≤ 0 ∧ (?bgrt = (- u + 1 * sqrt (u^2 - 4 * t * v)) / (2 * t) ∨ ?bgrt = (- u + -1 * sqrt (u^2 - 4 * t * v)) / (2 * t)))" proof - assume "t≠ 0" have "-1*u^2 + 4 * t * v ≤ 0 " using tuvprop1 discriminant_negative[of t u v] unfolding discrim_def using ‹t ≠ 0› by force then show ?thesis using tuvprop discriminant_nonneg[of t u v] unfolding discrim_def using ‹t ≠ 0› by auto qed have unonz: "(t = 0 ∧ u ≠ 0) ⟹ ?bgrt = - v / u" proof - assume "(t = 0 ∧ u ≠ 0)" then have "u*?bgrt + v = 0" using tuvprop1 by simp then show "?bgrt = - v / u" by (simp add: ‹t = 0 ∧ u ≠ 0› eq_minus_divide_eq mult.commute) qed have "∃y'. y' > x ∧ y' < ?srl ! (k+1)" using k_prop dense by blast then obtain y1 where y1_prop: "y1 > x ∧ y1 < ?srl ! (k+1)" by auto then have y1inbtw: "y1 > ?srl ! k ∧ y1 < ?srl ! (k+1)" using k_prop by auto have allpropb: "(∀(d, e, f)∈set b. ∀x∈{?bgrt<..y1}. d * x⇧2 + e * x + f < 0)" proof clarsimp fix t1 u1 v1 x1 assume ins: "(t1, u1, v1) ∈ set b" assume x1gt: "sorted_nonzero_root_list_set (set b ∪ set c ∪ set d) ! k < x1" assume x1lt: "x1 ≤ y1" have x1inbtw: "x1 > ?srl ! k ∧ x1 < ?srl ! (k+1)" using x1gt x1lt y1inbtw by (smt One_nat_def cases_gt k_prop) have xsn: "sign_num (t1 * x^2 + u1 * x + v1 ) = -1" using ins x_prop unfolding sign_num_def by auto have "sign_num (t1 * x1⇧2 + u1 * x1 + v1 ) = sign_num (t1 * x^2 + u1 * x + v1 ) " using ins x1inbtw samesign by blast then show "t1 * x1⇧2 + u1 * x1 + v1 < 0" using xsn unfolding sign_num_def by (metis add.right_inverse add.right_neutral linorder_neqE_linordered_idom one_add_one zero_neq_numeral) qed have allpropbvar: "(∀(d, e, f)∈set b. ∃y'>?bgrt. ∀x∈{?bgrt<..y'}. d * x⇧2 + e * x + f < 0)" proof clarsimp fix t1 u1 v1 assume "(t1, u1, v1) ∈ set b" then have "∀x∈{?bgrt<..y1}. t1 * x⇧2 + u1 * x + v1 < 0" using allpropb by force then show " ∃y'>sorted_nonzero_root_list_set (set b ∪ set c ∪ set d) ! k. ∀x∈{sorted_nonzero_root_list_set (set b ∪ set c ∪ set d) ! k<..y'}. t1 * x⇧2 + u1 * x + v1 < 0" using y1inbtw by blast qed have allpropc: "(∀(d, e, f)∈set c. ∀x∈{?bgrt<..y1}. d * x⇧2 + e * x + f ≤ 0)" proof clarsimp fix t1 u1 v1 x1 assume ins: "(t1, u1, v1) ∈ set c" assume x1gt: " sorted_nonzero_root_list_set (set b ∪ set c ∪ set d) ! k < x1" assume x1lt: "x1 ≤ y1" have x1inbtw: "x1 > ?srl ! k ∧ x1 < ?srl ! (k+1)" using x1gt x1lt y1inbtw by (smt One_nat_def cases_gt k_prop) have xsn: "sign_num (t1 * x^2 + u1 * x + v1 ) = -1 ∨ sign_num (t1 * x^2 + u1 * x + v1 ) = 0" using ins x_prop unfolding sign_num_def by auto have "sign_num (t1 * x1⇧2 + u1 * x1 + v1 ) = sign_num (t1 * x^2 + u1 * x + v1 ) " using ins x1inbtw samesign by blast then show "t1 * x1⇧2 + u1 * x1 + v1 ≤ 0" using xsn unfolding sign_num_def by (metis (no_types, hide_lams) equal_neg_zero less_eq_real_def linorder_not_less zero_neq_one) qed have allpropcvar: "(∀(d, e, f)∈set c. ∃y'>?bgrt. ∀x∈{?bgrt<..y'}. d * x⇧2 + e * x + f ≤ 0)" proof clarsimp fix t1 u1 v1 assume "(t1, u1, v1) ∈ set c" then have "∀x∈{?bgrt<..y1}. t1 * x⇧2 + u1 * x + v1 ≤ 0" using allpropc by force then show " ∃y'>sorted_nonzero_root_list_set (set b ∪ set c ∪ set d) ! k. ∀x∈{sorted_nonzero_root_list_set (set b ∪ set c ∪ set d) ! k<..y'}. t1 * x⇧2 + u1 * x + v1 ≤ 0" using y1inbtw by blast qed have allpropd: "(∀(d, e, f)∈set d. ∀x∈{?bgrt<..y1}. d * x⇧2 + e * x + f ≠ 0)" proof clarsimp fix t1 u1 v1 x1 assume ins: "(t1, u1, v1) ∈ set d" assume contrad:"t1 * x1⇧2 + u1 * x1 + v1 = 0" assume x1gt: " sorted_nonzero_root_list_set (set b ∪ set c ∪ set d) ! k < x1" assume x1lt: "x1 ≤ y1" have x1inbtw: "x1 > ?srl ! k ∧ x1 < ?srl ! (k+1)" using x1gt x1lt y1inbtw by (smt One_nat_def cases_gt k_prop) have xsn: "sign_num (t1 * x^2 + u1 * x + v1 ) = -1 ∨ sign_num (t1 * x^2 + u1 * x + v1 ) = 1" using ins x_prop unfolding sign_num_def by auto have "sign_num (t1 * x1⇧2 + u1 * x1 + v1 ) = sign_num (t1 * x^2 + u1 * x + v1 ) " using ins x1inbtw samesign by blast then have "t1 * x1⇧2 + u1 * x1 + v1 ≠ 0" using xsn unfolding sign_num_def by auto then show "False" using contrad by auto qed have allpropdvar: "(∀(d, e, f)∈set d. ∃y'>?bgrt. ∀x∈{?bgrt<..y'}. d * x⇧2 + e * x + f ≠ 0)" proof clarsimp fix t1 u1 v1 assume "(t1, u1, v1) ∈ set d" then have "∀x∈{?bgrt<..y1}. t1 * x⇧2 + u1 * x + v1 ≠ 0" using allpropd by force then show " ∃y'>sorted_nonzero_root_list_set (set b ∪ set c ∪ set d) ! k. ∀x∈{sorted_nonzero_root_list_set (set b ∪ set c ∪ set d) ! k<..y'}. t1 * x⇧2 + u1 * x + v1 ≠ 0" using y1inbtw by blast qed have "∀x. (∀(d, e, f)∈set a. d * x⇧2 + e * x + f = 0)" using alleqsetvar by auto then have ast: "(∀(d, e, f)∈set a. ∀x∈{?bgrt<..(?bgrt + 1)}. d * x⇧2 + e * x + f = 0)" by auto have allpropavar: "(∀(d, e, f)∈set a. ∃y'>?bgrt. ∀x∈{?bgrt<..y'}. d * x⇧2 + e * x + f = 0)" proof clarsimp fix t1 u1 v1 assume "(t1, u1, v1) ∈ set a" then have "∀x∈{?bgrt<..(?bgrt + 1)}. t1 * x⇧2 + u1 * x + v1 = 0 " using ast by auto then show "∃y'>sorted_nonzero_root_list_set (set b ∪ set c ∪ set d) ! k. ∀x∈{sorted_nonzero_root_list_set (set b ∪ set c ∪ set d) ! k<..y'}. t1 * x⇧2 + u1 * x + v1 = 0" using less_add_one by blast qed have quadsetb: "((t, u, v) ∈ set b ∧ t≠ 0) ⟹ False" proof - assume asm: "(t, u, v) ∈ set b ∧ t≠ 0" have bgrt1: "(?bgrt = (- u + 1 * sqrt (u^2 - 4 * t * v)) / (2 * t)) ⟹ False " proof - assume bgrtis: "?bgrt = (- u + 1 * sqrt (u^2 - 4 * t * v)) / (2 * t)" have discrim_prop: "-1*u^2 + 4 * t * v ≤ 0" using asm tnonz by blast have "((t, u, v)∈set b ∧ t ≠ 0 ∧ - 1*u^2 + 4 * t * v ≤ 0 ∧ ((∀(d, e, f)∈set a. ∃y'>?bgrt. ∀x∈{?bgrt<..y'}. d * x⇧2 + e * x + f = 0) ∧ (∀(d, e, f)∈set b. ∃y'>?bgrt. ∀x∈{?bgrt<..y'}. d * x⇧2 + e * x + f < 0) ∧ (∀(d, e, f)∈set c. ∃y'>?bgrt. ∀x∈{?bgrt<..y'}. d * x⇧2 + e * x + f ≤ 0) ∧ (∀(d, e, f)∈set d. ∃y'>?bgrt. ∀x∈{?bgrt<..y'}. d * x⇧2 + e * x + f ≠ 0)))" using asm discrim_prop allpropavar allpropbvar allpropcvar allpropdvar by linarith then show "False" using f6 bgrtis by auto qed have bgrt2: "(?bgrt = (- u + -1 * sqrt (u^2 - 4 * t * v)) / (2 * t)) ⟹ False " proof - assume bgrtis: "?bgrt = (- u + -1 * sqrt (u^2 - 4 * t * v)) / (2 * t)" have discrim_prop: "-1*u^2 + 4 * t * v ≤ 0" using asm tnonz by blast have "((t, u, v)∈set b ∧ t ≠ 0 ∧ - 1*u^2 + 4 * t * v ≤ 0 ∧ ((∀(d, e, f)∈set a. ∃y'>?bgrt. ∀x∈{?bgrt<..y'}. d * x⇧2 + e * x + f = 0) ∧ (∀(d, e, f)∈set b. ∃y'>?bgrt. ∀x∈{?bgrt<..y'}. d * x⇧2 + e * x + f < 0) ∧ (∀(d, e, f)∈set c. ∃y'>?bgrt. ∀x∈{?bgrt<..y'}. d * x⇧2 + e * x + f ≤ 0) ∧ (∀(d, e, f)∈set d. ∃y'>?bgrt. ∀x∈{?bgrt<..y'}. d * x⇧2 + e * x + f ≠ 0)))" using asm discrim_prop allpropavar allpropbvar allpropcvar allpropdvar by linarith then show "False" using f7 bgrtis by auto qed show "False" using tnonz bgrt1 bgrt2 asm by auto qed have linsetb: "((t, u, v) ∈ set b ∧ (t = 0 ∧ u ≠ 0)) ⟹ False" proof - assume asm: "(t, u, v) ∈ set b ∧ (t = 0 ∧ u ≠ 0)" then have bgrtis: "?bgrt = (- v / u)" using unonz by blast have "((t, u, v)∈set b ∧ (t = 0 ∧ u ≠ 0) ∧ ((∀(d, e, f)∈set a. ∃y'>?bgrt. ∀x∈{?bgrt<..y'}. d * x⇧2 + e * x + f = 0) ∧ (∀(d, e, f)∈set b. ∃y'>?bgrt. ∀x∈{?bgrt<..y'}. d * x⇧2 + e * x + f < 0) ∧ (∀(d, e, f)∈set c. ∃y'>?bgrt. ∀x∈{?bgrt<..y'}. d * x⇧2 + e * x + f ≤ 0) ∧ (∀(d, e, f)∈set d. ∃y'>?bgrt. ∀x∈{?bgrt<..y'}. d * x⇧2 + e * x + f ≠ 0)))" using asm allpropavar allpropbvar allpropcvar allpropdvar by linarith then show "False" using bgrtis f5 by auto qed have insetb: "((t, u, v) ∈ set b ∧ (t ≠ 0 ∨ u ≠ 0) ∧ (t * ?bgrt⇧2 + u * ?bgrt + v = 0)) ⟹ False" using quadsetb linsetb by auto have quadsetc: "(t, u, v) ∈ set c ∧ t≠ 0 ⟹ False" proof - assume asm: "(t, u, v) ∈ set c ∧ t≠ 0" have bgrt1: "(?bgrt = (- u + 1 * sqrt (u^2 - 4 * t * v)) / (2 * t)) ⟹ False " proof - assume bgrtis: "?bgrt = (- u + 1 * sqrt (u^2 - 4 * t * v)) / (2 * t)" have discrim_prop: "-1*u^2 + 4 * t * v ≤ 0" using asm tnonz by blast have "((t, u, v)∈set c ∧ t ≠ 0 ∧ - 1*u^2 + 4 * t * v ≤ 0 ∧ ((∀(d, e, f)∈set a. ∃y'>?bgrt. ∀x∈{?bgrt<..y'}. d * x⇧2 + e * x + f = 0) ∧ (∀(d, e, f)∈set b. ∃y'>?bgrt. ∀x∈{?bgrt<..y'}. d * x⇧2 + e * x + f < 0) ∧ (∀(d, e, f)∈set c. ∃y'>?bgrt. ∀x∈{?bgrt<..y'}. d * x⇧2 + e * x + f ≤ 0) ∧ (∀(d, e, f)∈set d. ∃y'>?bgrt. ∀x∈{?bgrt<..y'}. d * x⇧2 + e * x + f ≠ 0)))" using asm discrim_prop allpropavar allpropbvar allpropcvar allpropdvar by linarith then show "False" using f13a bgrtis by auto qed have bgrt2: "(?bgrt = (- u + -1 * sqrt (u^2 - 4 * t * v)) / (2 * t)) ⟹ False " proof - assume bgrtis: "?bgrt = (- u + -1 * sqrt (u^2 - 4 * t * v)) / (2 * t)" have discrim_prop: "-1*u^2 + 4 * t * v ≤ 0" using asm tnonz by blast have "((t, u, v)∈set c ∧ t ≠ 0 ∧ - 1*u^2 + 4 * t * v ≤ 0 ∧ ((∀(d, e, f)∈set a. ∃y'>?bgrt. ∀x∈{?bgrt<..y'}. d * x⇧2 + e * x + f = 0) ∧ (∀(d, e, f)∈set b. ∃y'>?bgrt. ∀x∈{?bgrt<..y'}. d * x⇧2 + e * x + f < 0) ∧ (∀(d, e, f)∈set c. ∃y'>?bgrt. ∀x∈{?bgrt<..y'}. d * x⇧2 + e * x + f ≤ 0) ∧ (∀(d, e, f)∈set d. ∃y'>?bgrt. ∀x∈{?bgrt<..y'}. d * x⇧2 + e * x + f ≠ 0)))" using asm discrim_prop allpropavar allpropbvar allpropcvar allpropdvar by linarith then show "False" using f9a bgrtis by auto qed show "False" using tnonz bgrt1 bgrt2 asm by auto qed have linsetc: "(t, u, v) ∈ set c ∧ (t = 0 ∧ u ≠ 0) ⟹ False" proof - assume asm: "(t, u, v) ∈ set c ∧ (t = 0 ∧ u ≠ 0)" then have bgrtis: "?bgrt = (- v / u)" using unonz by blast have "((t, u, v)∈set c ∧ (t = 0 ∧ u ≠ 0) ∧ ((∀(d, e, f)∈set a. ∃y'>?bgrt. ∀x∈{?bgrt<..y'}. d * x⇧2 + e * x + f = 0) ∧ (∀(d, e, f)∈set b. ∃y'>?bgrt. ∀x∈{?bgrt<..y'}. d * x⇧2 + e * x + f < 0) ∧ (∀(d, e, f)∈set c. ∃y'>?bgrt. ∀x∈{?bgrt<..y'}. d * x⇧2 + e * x + f ≤ 0) ∧ (∀(d, e, f)∈set d. ∃y'>?bgrt. ∀x∈{?bgrt<..y'}. d * x⇧2 + e * x + f ≠ 0)))" using asm allpropavar allpropbvar allpropcvar allpropdvar by linarith then show "False" using bgrtis f8a by auto qed have insetc: "((t, u, v) ∈ set c ∧ (t ≠ 0 ∨ u ≠ 0) ∧ (t * ?bgrt⇧2 + u * ?bgrt + v = 0)) ⟹ False" using quadsetc linsetc by auto have quadsetd: "(t, u, v) ∈ set d ∧ t≠ 0 ⟹ False" proof - assume asm: "(t, u, v) ∈ set d ∧ t≠ 0" have bgrt1: "(?bgrt = (- u + 1 * sqrt (u^2 - 4 * t * v)) / (2 * t)) ⟹ False " proof - assume bgrtis: "?bgrt = (- u + 1 * sqrt (u^2 - 4 * t * v)) / (2 * t)" have discrim_prop: "-1*u^2 + 4 * t * v ≤ 0" using asm tnonz by blast have "((t, u, v)∈set d ∧ t ≠ 0 ∧ - 1*u^2 + 4 * t * v ≤ 0 ∧ ((∀(d, e, f)∈set a. ∃y'>?bgrt. ∀x∈{?bgrt<..y'}. d * x⇧2 + e * x + f = 0) ∧ (∀(d, e, f)∈set b. ∃y'>?bgrt. ∀x∈{?bgrt<..y'}. d * x⇧2 + e * x + f < 0) ∧ (∀(d, e, f)∈set c. ∃y'>?bgrt. ∀x∈{?bgrt<..y'}. d * x⇧2 + e * x + f ≤ 0) ∧ (∀(d, e, f)∈set d. ∃y'>?bgrt. ∀x∈{?bgrt<..y'}. d * x⇧2 + e * x + f ≠ 0)))" using asm discrim_prop allpropavar allpropbvar allpropcvar allpropdvar by linarith then show "False" using f11 bgrtis by auto qed have bgrt2: "(?bgrt = (- u + -1 * sqrt (u^2 - 4 * t * v)) / (2 * t)) ⟹ False " proof - assume bgrtis: "?bgrt = (- u + -1 * sqrt (u^2 - 4 * t * v)) / (2 * t)" have discrim_prop: "-1*u^2 + 4 * t * v ≤ 0" using asm tnonz by blast have "((t, u, v)∈set d ∧ t ≠ 0 ∧ - 1*u^2 + 4 * t * v ≤ 0 ∧ ((∀(d, e, f)∈set a. ∃y'>?bgrt. ∀x∈{?bgrt<..y'}. d * x⇧2 + e * x + f = 0) ∧ (∀(d, e, f)∈set b. ∃y'>?bgrt. ∀x∈{?bgrt<..y'}. d * x⇧2 + e * x + f < 0) ∧ (∀(d, e, f)∈set c. ∃y'>?bgrt. ∀x∈{?bgrt<..y'}. d * x⇧2 + e * x + f ≤ 0) ∧ (∀(d, e, f)∈set d. ∃y'>?bgrt. ∀x∈{?bgrt<..y'}. d * x⇧2 + e * x + f ≠ 0)))" using asm discrim_prop allpropavar allpropbvar allpropcvar allpropdvar by linarith then show "False" using f12 bgrtis by auto qed show "False" using tnonz bgrt1 bgrt2 asm by auto qed have linsetd: "(t, u, v) ∈ set d ∧ (t = 0 ∧ u ≠ 0) ⟹ False" proof - assume asm: "(t, u, v) ∈ set d ∧ (t = 0 ∧ u ≠ 0)" then have bgrtis: "?bgrt = (- v / u)" using unonz by blast have "((t, u, v)∈set d ∧ (t = 0 ∧ u ≠ 0) ∧ ((∀(d, e, f)∈set a. ∃y'>?bgrt. ∀x∈{?bgrt<..y'}. d * x⇧2 + e * x + f = 0) ∧ (∀(d, e, f)∈set b. ∃y'>?bgrt. ∀x∈{?bgrt<..y'}. d * x⇧2 + e * x + f < 0) ∧ (∀(d, e, f)∈set c. ∃y'>?bgrt. ∀x∈{?bgrt<..y'}. d * x⇧2 + e * x + f ≤ 0) ∧ (∀(d, e, f)∈set d. ∃y'>?bgrt. ∀x∈{?bgrt<..y'}. d * x⇧2 + e * x + f ≠ 0)))" using asm allpropavar allpropbvar allpropcvar allpropdvar by linarith then show "False" using bgrtis f10 by auto qed have insetd: "((t, u, v) ∈ set d ∧ (t ≠ 0 ∨ u ≠ 0) ∧ (t * ?bgrt⇧2 + u * ?bgrt + v = 0)) ⟹ False" using quadsetd linsetd by auto then show "False" using insetb insetc insetd tuvprop by auto qed show "False" using cases cases_btw cases_mem cases_lt cases_gt by auto qed show "False" using asm len1 lengtone by linarith qed show "False" using lenzero lengt0 by linarith qed then show ?thesis by blast qed lemma qe_forwards: assumes "(∃x. (∀(a, b, c)∈set a. a * x⇧2 + b * x + c = 0) ∧ (∀(a, b, c)∈set b. a * x⇧2 + b * x + c < 0) ∧ (∀(a, b, c)∈set c. a * x⇧2 + b * x + c ≤ 0) ∧ (∀(a, b, c)∈set d. a * x⇧2 + b * x + c ≠ 0))" shows "((∀(a, b, c)∈set a. a = 0 ∧ b = 0 ∧ c = 0) ∧ (∀(a, b, c)∈set b. ∃x. ∀y<x. a * y⇧2 + b * y + c < 0) ∧ (∀(a, b, c)∈set c. ∃x. ∀y<x. a * y⇧2 + b * y + c ≤ 0) ∧ (∀(a, b, c)∈set d. ∃x. ∀y<x. a * y⇧2 + b * y + c ≠ 0) ∨ (∃(a', b', c')∈set a. (a' = 0 ∧ b' ≠ 0) ∧ (∀(d, e, f)∈set a. d * (- c' / b')⇧2 + e * (- c' / b') + f = 0) ∧ (∀(d, e, f)∈set b. d * (- c' / b')⇧2 + e * (- c' / b') + f < 0) ∧ (∀(d, e, f)∈set c. d * (- c' / b')⇧2 + e * (- c' / b') + f ≤ 0) ∧ (∀(d, e, f)∈set d. d * (- c' / b')⇧2 + e * (- c' / b') + f ≠ 0) ∨ a' ≠ 0 ∧ - b'⇧2 + 4 * a' * c' ≤ 0 ∧ ((∀(d, e, f)∈set a. d * ((- b' + 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a'))⇧2 + e * ((- b' + 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a')) + f = 0) ∧ (∀(d, e, f)∈set b. d * ((- b' + 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a'))⇧2 + e * ((- b' + 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a')) + f < 0) ∧ (∀(d, e, f)∈set c. d * ((- b' + 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a'))⇧2 + e * ((- b' + 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a')) + f ≤ 0) ∧ (∀(d, e, f)∈set d. d * ((- b' + 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a'))⇧2 + e * ((- b' + 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a')) + f ≠ 0) ∨ (∀(d, e, f)∈set a. d * ((- b' + - 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a'))⇧2 + e * ((- b' + - 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a')) + f = 0) ∧ (∀(d, e, f)∈set b. d * ((- b' + - 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a'))⇧2 + e * ((- b' + - 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a')) + f < 0) ∧ (∀(d, e, f)∈set c. d * ((- b' + - 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a'))⇧2 + e * ((- b' + - 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a')) + f ≤ 0) ∧ (∀(d, e, f)∈set d. d * ((- b' + - 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a'))⇧2 + e * ((- b' + - 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a')) + f ≠ 0))) ∨ (∃(a', b', c')∈set b. (a' = 0 ∧ b' ≠ 0) ∧ (∀(d, e, f)∈set a. ∃y'>- c' / b'. ∀x∈{- c' / b'<..y'}. d * x⇧2 + e * x + f = 0) ∧ (∀(d, e, f)∈set b. ∃y'>- c' / b'. ∀x∈{- c' / b'<..y'}. d * x⇧2 + e * x + f < 0) ∧ (∀(d, e, f)∈set c. ∃y'>- c' / b'. ∀x∈{- c' / b'<..y'}. d * x⇧2 + e * x + f ≤ 0) ∧ (∀(d, e, f)∈set d. ∃y'>- c' / b'. ∀x∈{- c' / b'<..y'}. d * x⇧2 + e * x + f ≠ 0) ∨ a' ≠ 0 ∧ - b'⇧2 + 4 * a' * c' ≤ 0 ∧ ((∀(d, e, f)∈set a. ∃y'>(- b' + 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a'). ∀x∈{(- b' + 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a')<..y'}. d * x⇧2 + e * x + f = 0) ∧ (∀(d, e, f)∈set b. ∃y'>(- b' + 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a'). ∀x∈{(- b' + 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a')<..y'}. d * x⇧2 + e * x + f < 0) ∧ (∀(d, e, f)∈set c. ∃y'>(- b' + 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a'). ∀x∈{(- b' + 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a')<..y'}. d * x⇧2 + e * x + f ≤ 0) ∧ (∀(d, e, f)∈set d. ∃y'>(- b' + 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a'). ∀x∈{(- b' + 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a')<..y'}. d * x⇧2 + e * x + f ≠ 0) ∨ (∀(d, e, f)∈set a. ∃y'>(- b' + - 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a'). ∀x∈{(- b' + - 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a')<..y'}. d * x⇧2 + e * x + f = 0) ∧ (∀(d, e, f)∈set b. ∃y'>(- b' + - 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a'). ∀x∈{(- b' + - 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a')<..y'}. d * x⇧2 + e * x + f < 0) ∧ (∀(d, e, f)∈set c. ∃y'>(- b' + - 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a'). ∀x∈{(- b' + - 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a')<..y'}. d * x⇧2 + e * x + f ≤ 0) ∧ (∀(d, e, f)∈set d. ∃y'>(- b' + - 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a'). ∀x∈{(- b' + - 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a')<..y'}. d * x⇧2 + e * x + f ≠ 0))) ∨ (∃(a', b', c')∈set c. (a' = 0 ∧ b' ≠ 0) ∧ (∀(d, e, f)∈set a. d * (- c' / b')⇧2 + e * (- c' / b') + f = 0) ∧ (∀(d, e, f)∈set b. d * (- c' / b')⇧2 + e * (- c' / b') + f < 0) ∧ (∀(d, e, f)∈set c. d * (- c' / b')⇧2 + e * (- c' / b') + f ≤ 0) ∧ (∀(d, e, f)∈set d. d * (- c' / b')⇧2 + e * (- c' / b') + f ≠ 0) ∨ a' ≠ 0 ∧ - b'⇧2 + 4 * a' * c' ≤ 0 ∧ ((∀(d, e, f)∈set a. d * ((- b' + 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a'))⇧2 + e * ((- b' + 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a')) + f = 0) ∧ (∀(d, e, f)∈set b. d * ((- b' + 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a'))⇧2 + e * ((- b' + 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a')) + f < 0) ∧ (∀(d, e, f)∈set c. d * ((- b' + 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a'))⇧2 + e * ((- b' + 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a')) + f ≤ 0) ∧ (∀(d, e, f)∈set d. d * ((- b' + 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a'))⇧2 + e * ((- b' + 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a')) + f ≠ 0) ∨ (∀(d, e, f)∈set a. d * ((- b' + - 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a'))⇧2 + e * ((- b' + - 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a')) + f = 0) ∧ (∀(d, e, f)∈set b. d * ((- b' + - 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a'))⇧2 + e * ((- b' + - 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a')) + f < 0) ∧ (∀(d, e, f)∈set c. d * ((- b' + - 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a'))⇧2 + e * ((- b' + - 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a')) + f ≤ 0) ∧ (∀(d, e, f)∈set d. d * ((- b' + - 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a'))⇧2 + e * ((- b' + - 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a')) + f ≠ 0))) ∨ (∃(a', b', c')∈set d. (a' = 0 ∧ b' ≠ 0) ∧ (∀(d, e, f)∈set a. ∃y'>- c' / b'. ∀x∈{- c' / b'<..y'}. d * x⇧2 + e * x + f = 0) ∧ (∀(d, e, f)∈set b. ∃y'>- c' / b'. ∀x∈{- c' / b'<..y'}. d * x⇧2 + e * x + f < 0) ∧ (∀(d, e, f)∈set c. ∃y'>- c' / b'. ∀x∈{- c' / b'<..y'}. d * x⇧2 + e * x + f ≤ 0) ∧ (∀(d, e, f)∈set d. ∃y'>- c' / b'. ∀x∈{- c' / b'<..y'}. d * x⇧2 + e * x + f ≠ 0) ∨ a' ≠ 0 ∧ - b'⇧2 + 4 * a' * c' ≤ 0 ∧ ((∀(d, e, f)∈set a. ∃y'>(- b' + 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a'). ∀x∈{(- b' + 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a')<..y'}. d * x⇧2 + e * x + f = 0) ∧ (∀(d, e, f)∈set b. ∃y'>(- b' + 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a'). ∀x∈{(- b' + 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a')<..y'}. d * x⇧2 + e * x + f < 0) ∧ (∀(d, e, f)∈set c. ∃y'>(- b' + 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a'). ∀x∈{(- b' + 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a')<..y'}. d * x⇧2 + e * x + f ≤ 0) ∧ (∀(d, e, f)∈set d. ∃y'>(- b' + 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a'). ∀x∈{(- b' + 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a')<..y'}. d * x⇧2 + e * x + f ≠ 0) ∨ (∀(d, e, f)∈set a. ∃y'>(- b' + - 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a'). ∀x∈{(- b' + - 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a')<..y'}. d * x⇧2 + e * x + f = 0) ∧ (∀(d, e, f)∈set b. ∃y'>(- b' + - 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a'). ∀x∈{(- b' + - 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a')<..y'}. d * x⇧2 + e * x + f < 0) ∧ (∀(d, e, f)∈set c. ∃y'>(- b' + - 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a'). ∀x∈{(- b' + - 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a')<..y'}. d * x⇧2 + e * x + f ≤ 0) ∧ (∀(d, e, f)∈set d. ∃y'>(- b' + - 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a'). ∀x∈{(- b' + - 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a')<..y'}. d * x⇧2 + e * x + f ≠ 0))))" (* using eq_qe_1 les_qe_1 *) proof - let ?e2 = "(((∀(a, b, c)∈set a. a = 0 ∧ b = 0 ∧ c = 0) ∧ (∀(a, b, c)∈set b. ∃x. ∀y<x. a * y⇧2 + b * y + c < 0) ∧ (∀(a, b, c)∈set c. ∃x. ∀y<x. a * y⇧2 + b * y + c ≤ 0) ∧ (∀(a, b, c)∈set d. ∃x. ∀y<x. a * y⇧2 + b * y + c ≠ 0) ∨ (∃(a', b', c')∈set a. (a' = 0 ∧ b' ≠ 0) ∧ (∀(d, e, f)∈set a. d * (- c' / b')⇧2 + e * (- c' / b') + f = 0) ∧ (∀(d, e, f)∈set b. d * (- c' / b')⇧2 + e * (- c' / b') + f < 0) ∧ (∀(d, e, f)∈set c. d * (- c' / b')⇧2 + e * (- c' / b') + f ≤ 0) ∧ (∀(d, e, f)∈set d. d * (- c' / b')⇧2 + e * (- c' / b') + f ≠ 0) ∨ a' ≠ 0 ∧ - b'⇧2 + 4 * a' * c' ≤ 0 ∧ ((∀(d, e, f)∈set a. d * ((- b' + 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a'))⇧2 + e * ((- b' + 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a')) + f = 0) ∧ (∀(d, e, f)∈set b. d * ((- b' + 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a'))⇧2 + e * ((- b' + 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a')) + f < 0) ∧ (∀(d, e, f)∈set c. d * ((- b' + 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a'))⇧2 + e * ((- b' + 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a')) + f ≤ 0) ∧ (∀(d, e, f)∈set d. d * ((- b' + 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a'))⇧2 + e * ((- b' + 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a')) + f ≠ 0) ∨ (∀(d, e, f)∈set a. d * ((- b' + - 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a'))⇧2 + e * ((- b' + - 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a')) + f = 0) ∧ (∀(d, e, f)∈set b. d * ((- b' + - 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a'))⇧2 + e * ((- b' + - 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a')) + f < 0) ∧ (∀(d, e, f)∈set c. d * ((- b' + - 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a'))⇧2 + e * ((- b' + - 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a')) + f ≤ 0) ∧ (∀(d, e, f)∈set d. d * ((- b' + - 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a'))⇧2 + e * ((- b' + - 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a')) + f ≠ 0))) ∨ (∃(a', b', c')∈set b. (a' = 0 ∧ b' ≠ 0) ∧ (∀(d, e, f)∈set a. ∃y'>- c' / b'. ∀x∈{- c' / b'<..y'}. d * x⇧2 + e * x + f = 0) ∧ (∀(d, e, f)∈set b. ∃y'>- c' / b'. ∀x∈{- c' / b'<..y'}. d * x⇧2 + e * x + f < 0) ∧ (∀(d, e, f)∈set c. ∃y'>- c' / b'. ∀x∈{- c' / b'<..y'}. d * x⇧2 + e * x + f ≤ 0) ∧ (∀(d, e, f)∈set d. ∃y'>- c' / b'. ∀x∈{- c' / b'<..y'}. d * x⇧2 + e * x + f ≠ 0) ∨ a' ≠ 0 ∧ - b'⇧2 + 4 * a' * c' ≤ 0 ∧ ((∀(d, e, f)∈set a. ∃y'>(- b' + 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a'). ∀x∈{(- b' + 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a')<..y'}. d * x⇧2 + e * x + f = 0) ∧ (∀(d, e, f)∈set b. ∃y'>(- b' + 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a'). ∀x∈{(- b' + 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a')<..y'}. d * x⇧2 + e * x + f < 0) ∧ (∀(d, e, f)∈set c. ∃y'>(- b' + 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a'). ∀x∈{(- b' + 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a')<..y'}. d * x⇧2 + e * x + f ≤ 0) ∧ (∀(d, e, f)∈set d. ∃y'>(- b' + 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a'). ∀x∈{(- b' + 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a')<..y'}. d * x⇧2 + e * x + f ≠ 0) ∨ (∀(d, e, f)∈set a. ∃y'>(- b' + - 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a'). ∀x∈{(- b' + - 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a')<..y'}. d * x⇧2 + e * x + f = 0) ∧ (∀(d, e, f)∈set b. ∃y'>(- b' + - 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a'). ∀x∈{(- b' + - 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a')<..y'}. d * x⇧2 + e * x + f < 0) ∧ (∀(d, e, f)∈set c. ∃y'>(- b' + - 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a'). ∀x∈{(- b' + - 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a')<..y'}. d * x⇧2 + e * x + f ≤ 0) ∧ (∀(d, e, f)∈set d. ∃y'>(- b' + - 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a'). ∀x∈{(- b' + - 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a')<..y'}. d * x⇧2 + e * x + f ≠ 0))) ∨ (∃(a', b', c')∈set c. (a' = 0 ∧ b' ≠ 0) ∧ (∀(d, e, f)∈set a. d * (- c' / b')⇧2 + e * (- c' / b') + f = 0) ∧ (∀(d, e, f)∈set b. d * (- c' / b')⇧2 + e * (- c' / b') + f < 0) ∧ (∀(d, e, f)∈set c. d * (- c' / b')⇧2 + e * (- c' / b') + f ≤ 0) ∧ (∀(d, e, f)∈set d. d * (- c' / b')⇧2 + e * (- c' / b') + f ≠ 0) ∨ a' ≠ 0 ∧ - b'⇧2 + 4 * a' * c' ≤ 0 ∧ ((∀(d, e, f)∈set a. d * ((- b' + 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a'))⇧2 + e * ((- b' + 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a')) + f = 0) ∧ (∀(d, e, f)∈set b. d * ((- b' + 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a'))⇧2 + e * ((- b' + 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a')) + f < 0) ∧ (∀(d, e, f)∈set c. d * ((- b' + 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a'))⇧2 + e * ((- b' + 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a')) + f ≤ 0) ∧ (∀(d, e, f)∈set d. d * ((- b' + 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a'))⇧2 + e * ((- b' + 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a')) + f ≠ 0) ∨ (∀(d, e, f)∈set a. d * ((- b' + - 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a'))⇧2 + e * ((- b' + - 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a')) + f = 0) ∧ (∀(d, e, f)∈set b. d * ((- b' + - 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a'))⇧2 + e * ((- b' + - 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a')) + f < 0) ∧ (∀(d, e, f)∈set c. d * ((- b' + - 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a'))⇧2 + e * ((- b' + - 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a')) + f ≤ 0) ∧ (∀(d, e, f)∈set d. d * ((- b' + - 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a'))⇧2 + e * ((- b' + - 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a')) + f ≠ 0))) ∨ (∃(a', b', c')∈set d. (a' = 0 ∧ b' ≠ 0) ∧ (∀(d, e, f)∈set a. ∃y'>- c' / b'. ∀x∈{- c' / b'<..y'}. d * x⇧2 + e * x + f = 0) ∧ (∀(d, e, f)∈set b. ∃y'>- c' / b'. ∀x∈{- c' / b'<..y'}. d * x⇧2 + e * x + f < 0) ∧ (∀(d, e, f)∈set c. ∃y'>- c' / b'. ∀x∈{- c' / b'<..y'}. d * x⇧2 + e * x + f ≤ 0) ∧ (∀(d, e, f)∈set d. ∃y'>- c' / b'. ∀x∈{- c' / b'<..y'}. d * x⇧2 + e * x + f ≠ 0) ∨ a' ≠ 0 ∧ - b'⇧2 + 4 * a' * c' ≤ 0 ∧ ((∀(d, e, f)∈set a. ∃y'>(- b' + 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a'). ∀x∈{(- b' + 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a')<..y'}. d * x⇧2 + e * x + f = 0) ∧ (∀(d, e, f)∈set b. ∃y'>(- b' + 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a'). ∀x∈{(- b' + 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a')<..y'}. d * x⇧2 + e * x + f < 0) ∧ (∀(d, e, f)∈set c. ∃y'>(- b' + 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a'). ∀x∈{(- b' + 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a')<..y'}. d * x⇧2 + e * x + f ≤ 0) ∧ (∀(d, e, f)∈set d. ∃y'>(- b' + 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a'). ∀x∈{(- b' + 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a')<..y'}. d * x⇧2 + e * x + f ≠ 0) ∨ (∀(d, e, f)∈set a. ∃y'>(- b' + - 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a'). ∀x∈{(- b' + - 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a')<..y'}. d * x⇧2 + e * x + f = 0) ∧ (∀(d, e, f)∈set b. ∃y'>(- b' + - 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a'). ∀x∈{(- b' + - 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a')<..y'}. d * x⇧2 + e * x + f < 0) ∧ (∀(d, e, f)∈set c. ∃y'>(- b' + - 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a'). ∀x∈{(- b' + - 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a')<..y'}. d * x⇧2 + e * x + f ≤ 0) ∧ (∀(d, e, f)∈set d. ∃y'>(- b' + - 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a'). ∀x∈{(- b' + - 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a')<..y'}. d * x⇧2 + e * x + f ≠ 0)))))" let ?f10orf11orf12 = "(∃(a', b', c')∈set d. (a' = 0 ∧ b' ≠ 0) ∧ (∀(d, e, f)∈set a. ∃y'>- c' / b'. ∀x∈{- c' / b'<..y'}. d * x⇧2 + e * x + f = 0) ∧ (∀(d, e, f)∈set b. ∃y'>- c' / b'. ∀x∈{- c' / b'<..y'}. d * x⇧2 + e * x + f < 0) ∧ (∀(d, e, f)∈set c. ∃y'>- c' / b'. ∀x∈{- c' / b'<..y'}. d * x⇧2 + e * x + f ≤ 0) ∧ (∀(d, e, f)∈set d. ∃y'>- c' / b'. ∀x∈{- c' / b'<..y'}. d * x⇧2 + e * x + f ≠ 0) ∨ a' ≠ 0 ∧ - b'⇧2 + 4 * a' * c' ≤ 0 ∧ ((∀(d, e, f)∈set a. ∃y'>(- b' + 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a'). ∀x∈{(- b' + 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a')<..y'}. d * x⇧2 + e * x + f = 0) ∧ (∀(d, e, f)∈set b. ∃y'>(- b' + 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a'). ∀x∈{(- b' + 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a')<..y'}. d * x⇧2 + e * x + f < 0) ∧ (∀(d, e, f)∈set c. ∃y'>(- b' + 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a'). ∀x∈{(- b' + 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a')<..y'}. d * x⇧2 + e * x + f ≤ 0) ∧ (∀(d, e, f)∈set d. ∃y'>(- b' + 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a'). ∀x∈{(- b' + 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a')<..y'}. d * x⇧2 + e * x + f ≠ 0) ∨ (∀(d, e, f)∈set a. ∃y'>(- b' + - 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a'). ∀x∈{(- b' + - 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a')<..y'}. d * x⇧2 + e * x + f = 0) ∧ (∀(d, e, f)∈set b. ∃y'>(- b' + - 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a'). ∀x∈{(- b' + - 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a')<..y'}. d * x⇧2 + e * x + f < 0) ∧ (∀(d, e, f)∈set c. ∃y'>(- b' + - 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a'). ∀x∈{(- b' + - 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a')<..y'}. d * x⇧2 + e * x + f ≤ 0) ∧ (∀(d, e, f)∈set d. ∃y'>(- b' + - 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a'). ∀x∈{(- b' + - 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a')<..y'}. d * x⇧2 + e * x + f ≠ 0)))" let ?f8orf9 = "(∃(a', b', c')∈set c. (a' = 0 ∧ b' ≠ 0) ∧ (∀(d, e, f)∈set a. d * (- c' / b')⇧2 + e * (- c' / b') + f = 0) ∧ (∀(d, e, f)∈set b. d * (- c' / b')⇧2 + e * (- c' / b') + f < 0) ∧ (∀(d, e, f)∈set c. d * (- c' / b')⇧2 + e * (- c' / b') + f ≤ 0) ∧ (∀(d, e, f)∈set d. d * (- c' / b')⇧2 + e * (- c' / b') + f ≠ 0) ∨ a' ≠ 0 ∧ - b'⇧2 + 4 * a' * c' ≤ 0 ∧ ((∀(d, e, f)∈set a. d * ((- b' + 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a'))⇧2 + e * ((- b' + 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a')) + f = 0) ∧ (∀(d, e, f)∈set b. d * ((- b' + 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a'))⇧2 + e * ((- b' + 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a')) + f < 0) ∧ (∀(d, e, f)∈set c. d * ((- b' + 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a'))⇧2 + e * ((- b' + 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a')) + f ≤ 0) ∧ (∀(d, e, f)∈set d. d * ((- b' + 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a'))⇧2 + e * ((- b' + 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a')) + f ≠ 0) ∨ (∀(d, e, f)∈set a. d * ((- b' + - 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a'))⇧2 + e * ((- b' + - 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a')) + f = 0) ∧ (∀(d, e, f)∈set b. d * ((- b' + - 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a'))⇧2 + e * ((- b' + - 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a')) + f < 0) ∧ (∀(d, e, f)∈set c. d * ((- b' + - 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a'))⇧2 + e * ((- b' + - 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a')) + f ≤ 0) ∧ (∀(d, e, f)∈set d. d * ((- b' + - 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a'))⇧2 + e * ((- b' + - 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a')) + f ≠ 0)))" let ?f5orf6orf7 = "(∃(a', b', c')∈set b. (a' = 0 ∧ b' ≠ 0) ∧ (∀(d, e, f)∈set a. ∃y'>- c' / b'. ∀x∈{- c' / b'<..y'}. d * x⇧2 + e * x + f = 0) ∧ (∀(d, e, f)∈set b. ∃y'>- c' / b'. ∀x∈{- c' / b'<..y'}. d * x⇧2 + e * x + f < 0) ∧ (∀(d, e, f)∈set c. ∃y'>- c' / b'. ∀x∈{- c' / b'<..y'}. d * x⇧2 + e * x + f ≤ 0) ∧ (∀(d, e, f)∈set d. ∃y'>- c' / b'. ∀x∈{- c' / b'<..y'}. d * x⇧2 + e * x + f ≠ 0) ∨ a' ≠ 0 ∧ - b'⇧2 + 4 * a' * c' ≤ 0 ∧ ((∀(d, e, f)∈set a. ∃y'>(- b' + 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a'). ∀x∈{(- b' + 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a')<..y'}. d * x⇧2 + e * x + f = 0) ∧ (∀(d, e, f)∈set b. ∃y'>(- b' + 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a'). ∀x∈{(- b' + 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a')<..y'}. d * x⇧2 + e * x + f < 0) ∧ (∀(d, e, f)∈set c. ∃y'>(- b' + 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a'). ∀x∈{(- b' + 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a')<..y'}. d * x⇧2 + e * x + f ≤ 0) ∧ (∀(d, e, f)∈set d. ∃y'>(- b' + 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a'). ∀x∈{(- b' + 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a')<..y'}. d * x⇧2 + e * x + f ≠ 0) ∨ (∀(d, e, f)∈set a. ∃y'>(- b' + - 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a'). ∀x∈{(- b' + - 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a')<..y'}. d * x⇧2 + e * x + f = 0) ∧ (∀(d, e, f)∈set b. ∃y'>(- b' + - 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a'). ∀x∈{(- b' + - 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a')<..y'}. d * x⇧2 + e * x + f < 0) ∧ (∀(d, e, f)∈set c. ∃y'>(- b' + - 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a'). ∀x∈{(- b' + - 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a')<..y'}. d * x⇧2 + e * x + f ≤ 0) ∧ (∀(d, e, f)∈set d. ∃y'>(- b' + - 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a'). ∀x∈{(- b' + - 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a')<..y'}. d * x⇧2 + e * x + f ≠ 0)))" let ?f2orf3orf4 = "(∃(a', b', c')∈set a. (a' = 0 ∧ b' ≠ 0) ∧ (∀(d, e, f)∈set a. d * (- c' / b')⇧2 + e * (- c' / b') + f = 0) ∧ (∀(d, e, f)∈set b. d * (- c' / b')⇧2 + e * (- c' / b') + f < 0) ∧ (∀(d, e, f)∈set c. d * (- c' / b')⇧2 + e * (- c' / b') + f ≤ 0) ∧ (∀(d, e, f)∈set d. d * (- c' / b')⇧2 + e * (- c' / b') + f ≠ 0) ∨ a' ≠ 0 ∧ - b'⇧2 + 4 * a' * c' ≤ 0 ∧ ((∀(d, e, f)∈set a. d * ((- b' + 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a'))⇧2 + e * ((- b' + 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a')) + f = 0) ∧ (∀(d, e, f)∈set b. d * ((- b' + 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a'))⇧2 + e * ((- b' + 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a')) + f < 0) ∧ (∀(d, e, f)∈set c. d * ((- b' + 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a'))⇧2 + e * ((- b' + 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a')) + f ≤ 0) ∧ (∀(d, e, f)∈set d. d * ((- b' + 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a'))⇧2 + e * ((- b' + 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a')) + f ≠ 0) ∨ (∀(d, e, f)∈set a. d * ((- b' + - 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a'))⇧2 + e * ((- b' + - 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a')) + f = 0) ∧ (∀(d, e, f)∈set b. d * ((- b' + - 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a'))⇧2 + e * ((- b' + - 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a')) + f < 0) ∧ (∀(d, e, f)∈set c. d * ((- b' + - 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a'))⇧2 + e * ((- b' + - 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a')) + f ≤ 0) ∧ (∀(d, e, f)∈set d. d * ((- b' + - 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a'))⇧2 + e * ((- b' + - 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a')) + f ≠ 0)))" let ?e1 = "(∃x. (∀(a, b, c)∈set a. a * x⇧2 + b * x + c = 0) ∧ (∀(a, b, c)∈set b. a * x⇧2 + b * x + c < 0) ∧ (∀(a, b, c)∈set c. a * x⇧2 + b * x + c ≤ 0) ∧ (∀(a, b, c)∈set d. a * x⇧2 + b * x + c ≠ 0))" let ?f1 = "((∀(a, b, c)∈set a. a = 0 ∧ b = 0 ∧ c = 0) ∧ (∀(a, b, c)∈set b. ∃x. ∀y<x. a * y⇧2 + b * y + c < 0) ∧ (∀(a, b, c)∈set c. ∃x. ∀y<x. a * y⇧2 + b * y + c ≤ 0) ∧ (∀(a, b, c)∈set d. ∃x. ∀y<x. a * y⇧2 + b * y + c ≠ 0))" let ?f2 = "(∃(a', b', c')∈set a. (a' = 0 ∧ b' ≠ 0) ∧ (∀(d, e, f)∈set a. d * (- c' / b')⇧2 + e * (- c' / b') + f = 0) ∧ (∀(d, e, f)∈set b. d * (- c' / b')⇧2 + e * (- c' / b') + f < 0) ∧ (∀(d, e, f)∈set c. d * (- c' / b')⇧2 + e * (- c' / b') + f ≤ 0) ∧ (∀(d, e, f)∈set d. d * (- c' / b')⇧2 + e * (- c' / b') + f ≠ 0))" let ?f3 = "(∃(a', b', c')∈set a. a' ≠ 0 ∧ - b'⇧2 + 4 * a' * c' ≤ 0 ∧ (∀(d, e, f)∈set a. d * ((- b' + 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a'))⇧2 + e * ((- b' + 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a')) + f = 0) ∧ (∀(d, e, f)∈set b. d * ((- b' + 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a'))⇧2 + e * ((- b' + 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a')) + f < 0) ∧ (∀(d, e, f)∈set c. d * ((- b' + 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a'))⇧2 + e * ((- b' + 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a')) + f ≤ 0) ∧ (∀(d, e, f)∈set d. d * ((- b' + 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a'))⇧2 + e * ((- b' + 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a')) + f ≠ 0))" let ?f4 = "(∃(a', b', c')∈set a. a' ≠ 0 ∧ - b'⇧2 + 4 * a' * c' ≤ 0 ∧ (∀(d, e, f)∈set a. d * ((- b' + - 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a'))⇧2 + e * ((- b' + - 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a')) + f = 0) ∧ (∀(d, e, f)∈set b. d * ((- b' + - 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a'))⇧2 + e * ((- b' + - 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a')) + f < 0) ∧ (∀(d, e, f)∈set c. d * ((- b' + - 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a'))⇧2 + e * ((- b' + - 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a')) + f ≤ 0) ∧ (∀(d, e, f)∈set d. d * ((- b' + - 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a'))⇧2 + e * ((- b' + - 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a')) + f ≠ 0)) " let ?f5 = "(∃(a', b', c')∈set b. (a' = 0 ∧ b' ≠ 0) ∧ (∀(d, e, f)∈set a. ∃y'>- c' / b'. ∀x∈{- c' / b'<..y'}. d * x⇧2 + e * x + f = 0) ∧ (∀(d, e, f)∈set b. ∃y'>- c' / b'. ∀x∈{- c' / b'<..y'}. d * x⇧2 + e * x + f < 0) ∧ (∀(d, e, f)∈set c. ∃y'>- c' / b'. ∀x∈{- c' / b'<..y'}. d * x⇧2 + e * x + f ≤ 0) ∧ (∀(d, e, f)∈set d. ∃y'>- c' / b'. ∀x∈{- c' / b'<..y'}. d * x⇧2 + e * x + f ≠ 0))" let ?f6 = "(∃(a', b', c')∈set b. a' ≠ 0 ∧ - b'⇧2 + 4 * a' * c' ≤ 0 ∧ ((∀(d, e, f)∈set a. ∃y'>(- b' + 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a'). ∀x∈{(- b' + 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a')<..y'}. d * x⇧2 + e * x + f = 0) ∧ (∀(d, e, f)∈set b. ∃y'>(- b' + 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a'). ∀x∈{(- b' + 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a')<..y'}. d * x⇧2 + e * x + f < 0) ∧ (∀(d, e, f)∈set c. ∃y'>(- b' + 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a'). ∀x∈{(- b' + 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a')<..y'}. d * x⇧2 + e * x + f ≤ 0) ∧ (∀(d, e, f)∈set d. ∃y'>(- b' + 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a'). ∀x∈{(- b' + 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a')<..y'}. d * x⇧2 + e * x + f ≠ 0)))" let ?f7 = "(∃(a', b', c')∈set b. a' ≠ 0 ∧ - b'⇧2 + 4 * a' * c' ≤ 0 ∧ (∀(d, e, f)∈set a. ∃y'>(- b' + - 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a'). ∀x∈{(- b' + - 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a')<..y'}. d * x⇧2 + e * x + f = 0) ∧ (∀(d, e, f)∈set b. ∃y'>(- b' + - 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a'). ∀x∈{(- b' + - 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a')<..y'}. d * x⇧2 + e * x + f < 0) ∧ (∀(d, e, f)∈set c. ∃y'>(- b' + - 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a'). ∀x∈{(- b' + - 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a')<..y'}. d * x⇧2 + e * x + f ≤ 0) ∧ (∀(d, e, f)∈set d. ∃y'>(- b' + - 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a'). ∀x∈{(- b' + - 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a')<..y'}. d * x⇧2 + e * x + f ≠ 0))" let ?f8 = "(∃(a', b', c')∈set c. (a' = 0 ∧ b' ≠ 0) ∧ (∀(d, e, f)∈set a. d * (- c' / b')⇧2 + e * (- c' / b') + f = 0) ∧ (∀(d, e, f)∈set b. d * (- c' / b')⇧2 + e * (- c' / b') + f < 0) ∧ (∀(d, e, f)∈set c. d * (- c' / b')⇧2 + e * (- c' / b') + f ≤ 0) ∧ (∀(d, e, f)∈set d. d * (- c' / b')⇧2 + e * (- c' / b') + f ≠ 0))" let ?f13 = "(∃(a', b', c')∈set c. a' ≠ 0 ∧ - b'⇧2 + 4 * a' * c' ≤ 0 ∧ ((∀(d, e, f)∈set a. d * ((- b' + 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a'))⇧2 + e * ((- b' + 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a')) + f = 0) ∧ (∀(d, e, f)∈set b. d * ((- b' + 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a'))⇧2 + e * ((- b' + 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a')) + f < 0) ∧ (∀(d, e, f)∈set c. d * ((- b' + 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a'))⇧2 + e * ((- b' + 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a')) + f ≤ 0) ∧ (∀(d, e, f)∈set d. d * ((- b' + 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a'))⇧2 + e * ((- b' + 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a')) + f ≠ 0)))" let ?f9 = "(∃(a', b', c')∈set c. a' ≠ 0 ∧ - b'⇧2 + 4 * a' * c' ≤ 0 ∧ (∀(d, e, f)∈set a. d * ((- b' + - 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a'))⇧2 + e * ((- b' + - 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a')) + f = 0) ∧ (∀(d, e, f)∈set b. d * ((- b' + - 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a'))⇧2 + e * ((- b' + - 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a')) + f < 0) ∧ (∀(d, e, f)∈set c. d * ((- b' + - 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a'))⇧2 + e * ((- b' + - 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a')) + f ≤ 0) ∧ (∀(d, e, f)∈set d. d * ((- b' + - 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a'))⇧2 + e * ((- b' + - 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a')) + f ≠ 0))" let ?f10 = "(∃(a', b', c')∈set d. (a' = 0 ∧ b' ≠ 0) ∧ (∀(d, e, f)∈set a. ∃y'>- c' / b'. ∀x∈{- c' / b'<..y'}. d * x⇧2 + e * x + f = 0) ∧ (∀(d, e, f)∈set b. ∃y'>- c' / b'. ∀x∈{- c' / b'<..y'}. d * x⇧2 + e * x + f < 0) ∧ (∀(d, e, f)∈set c. ∃y'>- c' / b'. ∀x∈{- c' / b'<..y'}. d * x⇧2 + e * x + f ≤ 0) ∧ (∀(d, e, f)∈set d. ∃y'>- c' / b'. ∀x∈{- c' / b'<..y'}. d * x⇧2 + e * x + f ≠ 0))" let ?f11 = "(∃(a', b', c')∈set d. a' ≠ 0 ∧ - b'⇧2 + 4 * a' * c' ≤ 0 ∧ ((∀(d, e, f)∈set a. ∃y'>(- b' + 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a'). ∀x∈{(- b' + 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a')<..y'}. d * x⇧2 + e * x + f = 0) ∧ (∀(d, e, f)∈set b. ∃y'>(- b' + 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a'). ∀x∈{(- b' + 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a')<..y'}. d * x⇧2 + e * x + f < 0) ∧ (∀(d, e, f)∈set c. ∃y'>(- b' + 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a'). ∀x∈{(- b' + 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a')<..y'}. d * x⇧2 + e * x + f ≤ 0) ∧ (∀(d, e, f)∈set d. ∃y'>(- b' + 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a'). ∀x∈{(- b' + 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a')<..y'}. d * x⇧2 + e * x + f ≠ 0)))" let ?f12 = "(∃(a', b', c')∈set d. a' ≠ 0 ∧ - b'⇧2 + 4 * a' * c' ≤ 0 ∧ (∀(d, e, f)∈set a. ∃y'>(- b' + - 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a'). ∀x∈{(- b' + - 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a')<..y'}. d * x⇧2 + e * x + f = 0) ∧ (∀(d, e, f)∈set b. ∃y'>(- b' + - 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a'). ∀x∈{(- b' + - 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a')<..y'}. d * x⇧2 + e * x + f < 0) ∧ (∀(d, e, f)∈set c. ∃y'>(- b' + - 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a'). ∀x∈{(- b' + - 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a')<..y'}. d * x⇧2 + e * x + f ≤ 0) ∧ (∀(d, e, f)∈set d. ∃y'>(- b' + - 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a'). ∀x∈{(- b' + - 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a')<..y'}. d * x⇧2 + e * x + f ≠ 0))" have h1a: "(?f1 ∨ ?f2orf3orf4 ∨ ?f5orf6orf7 ∨ ?f8orf9 ∨ ?f10orf11orf12) ⟶ ?e2" by auto have h2: "(?f2 ∨ ?f3 ∨ ?f4) ⟶ ?f2orf3orf4" by auto then have h1b: "(?f1 ∨ ?f2 ∨ ?f3 ∨ ?f4 ∨ ?f5orf6orf7 ∨ ?f8orf9 ∨ ?f10orf11orf12) ⟶ ?e2" using h1a by auto have h3: "(?f5 ∨ ?f6 ∨ ?f7) ⟶ ?f5orf6orf7" by auto then have h1c: "(?f1 ∨ ?f2 ∨ ?f3 ∨ ?f4 ∨ ?f5 ∨ ?f6 ∨ ?f7 ∨ ?f8orf9 ∨ ?f10orf11orf12) ⟶ ?e2" using h1b by smt have h4: "(?f8 ∨ ?f9 ∨ ?f13) ⟶ ?f8orf9" by auto then have h1d: "(?f1 ∨ ?f2 ∨ ?f3 ∨ ?f4 ∨ ?f5 ∨ ?f6 ∨ ?f7 ∨ ?f8 ∨ ?f9 ∨ ?f13 ∨ ?f10orf11orf12) ⟶ ?e2" using h1c by smt have h5: "(?f10 ∨ ?f11 ∨ ?f12) ⟶ ?f10orf11orf12" by auto then have bigor: "(?f1 ∨ ?f2 ∨ ?f3 ∨ ?f4 ∨ ?f5 ∨ ?f6 ∨ ?f7 ∨ ?f8 ∨ ?f13 ∨ ?f9 ∨ ?f10 ∨ ?f11 ∨ ?f12) ⟶ ?e2 " using h1d by smt then have bigor_var: "¬?e2 ⟶ ¬(?f1 ∨ ?f2 ∨ ?f3 ∨ ?f4 ∨ ?f5 ∨ ?f6 ∨ ?f7 ∨ ?f8 ∨ ?f13 ∨ ?f9 ∨ ?f10 ∨ ?f11 ∨ ?f12) " using contrapos_nn by smt have not_eq: "¬(?f1 ∨ ?f2 ∨ ?f3 ∨ ?f4 ∨ ?f5 ∨ ?f6 ∨ ?f7 ∨ ?f8 ∨ ?f13 ∨ ?f9 ∨ ?f10 ∨ ?f11 ∨ ?f12) =(¬?f1 ∧ ¬?f2 ∧ ¬?f3 ∧ ¬?f4 ∧ ¬?f5 ∧ ¬?f6 ∧ ¬?f7 ∧ ¬?f8 ∧ ¬?f13 ∧ ¬?f9 ∧ ¬?f10 ∧ ¬?f11 ∧ ¬?f12) " by linarith obtain x where x_prop: "(∀(a, b, c)∈set a. a * x⇧2 + b * x + c = 0) ∧ (∀(a, b, c)∈set b. a * x⇧2 + b * x + c < 0) ∧ (∀(a, b, c)∈set c. a * x⇧2 + b * x + c ≤ 0) ∧ (∀(a, b, c)∈set d. a * x⇧2 + b * x + c ≠ 0)" using assms by auto have "(¬?f1 ∧ ¬?f2 ∧ ¬?f3 ∧ ¬?f4 ∧ ¬?f5 ∧ ¬?f6 ∧ ¬?f7 ∧ ¬?f8 ∧ ¬?f13 ∧ ¬?f9 ∧ ¬?f10 ∧ ¬?f11 ∧ ¬?f12) ⟹ False" proof - assume big_not: " ¬ ((∀(a, b, c)∈set a. a = 0 ∧ b = 0 ∧ c = 0) ∧ (∀(a, b, c)∈set b. ∃x. ∀y<x. a * y⇧2 + b * y + c < 0) ∧ (∀(a, b, c)∈set c. ∃x. ∀y<x. a * y⇧2 + b * y + c ≤ 0) ∧ (∀(a, b, c)∈set d. ∃x. ∀y<x. a * y⇧2 + b * y + c ≠ 0)) ∧ ¬ (∃(a', b', c')∈set a. (a' = 0 ∧ b' ≠ 0) ∧ (∀(d, e, f)∈set a. d * (- c' / b')⇧2 + e * (- c' / b') + f = 0) ∧ (∀(d, e, f)∈set b. d * (- c' / b')⇧2 + e * (- c' / b') + f < 0) ∧ (∀(d, e, f)∈set c. d * (- c' / b')⇧2 + e * (- c' / b') + f ≤ 0) ∧ (∀(d, e, f)∈set d. d * (- c' / b')⇧2 + e * (- c' / b') + f ≠ 0)) ∧ ¬ (∃(a', b', c')∈set a. a' ≠ 0 ∧ - b'⇧2 + 4 * a' * c' ≤ 0 ∧ (∀(d, e, f)∈set a. d * ((- b' + 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a'))⇧2 + e * ((- b' + 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a')) + f = 0) ∧ (∀(d, e, f)∈set b. d * ((- b' + 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a'))⇧2 + e * ((- b' + 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a')) + f < 0) ∧ (∀(d, e, f)∈set c. d * ((- b' + 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a'))⇧2 + e * ((- b' + 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a')) + f ≤ 0) ∧ (∀(d, e, f)∈set d. d * ((- b' + 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a'))⇧2 + e * ((- b' + 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a')) + f ≠ 0)) ∧ ¬ (∃(a', b', c')∈set a. a' ≠ 0 ∧ - b'⇧2 + 4 * a' * c' ≤ 0 ∧ (∀(d, e, f)∈set a. d * ((- b' + - 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a'))⇧2 + e * ((- b' + - 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a')) + f = 0) ∧ (∀(d, e, f)∈set b. d * ((- b' + - 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a'))⇧2 + e * ((- b' + - 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a')) + f < 0) ∧ (∀(d, e, f)∈set c. d * ((- b' + - 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a'))⇧2 + e * ((- b' + - 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a')) + f ≤ 0) ∧ (∀(d, e, f)∈set d. d * ((- b' + - 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a'))⇧2 + e * ((- b' + - 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a')) + f ≠ 0)) ∧ ¬ (∃(a', b', c')∈set b. (a' = 0 ∧ b' ≠ 0) ∧ (∀(d, e, f)∈set a. ∃y'>- c' / b'. ∀x∈{- c' / b'<..y'}. d * x⇧2 + e * x + f = 0) ∧ (∀(d, e, f)∈set b. ∃y'>- c' / b'. ∀x∈{- c' / b'<..y'}. d * x⇧2 + e * x + f < 0) ∧ (∀(d, e, f)∈set c. ∃y'>- c' / b'. ∀x∈{- c' / b'<..y'}. d * x⇧2 + e * x + f ≤ 0) ∧ (∀(d, e, f)∈set d. ∃y'>- c' / b'. ∀x∈{- c' / b'<..y'}. d * x⇧2 + e * x + f ≠ 0)) ∧ ¬ (∃(a', b', c')∈set b. a' ≠ 0 ∧ - b'⇧2 + 4 * a' * c' ≤ 0 ∧ (∀(d, e, f)∈set a. ∃y'>(- b' + 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a'). ∀x∈{(- b' + 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a')<..y'}. d * x⇧2 + e * x + f = 0) ∧ (∀(d, e, f)∈set b. ∃y'>(- b' + 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a'). ∀x∈{(- b' + 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a')<..y'}. d * x⇧2 + e * x + f < 0) ∧ (∀(d, e, f)∈set c. ∃y'>(- b' + 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a'). ∀x∈{(- b' + 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a')<..y'}. d * x⇧2 + e * x + f ≤ 0) ∧ (∀(d, e, f)∈set d. ∃y'>(- b' + 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a'). ∀x∈{(- b' + 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a')<..y'}. d * x⇧2 + e * x + f ≠ 0)) ∧ ¬ (∃(a', b', c')∈set b. a' ≠ 0 ∧ - b'⇧2 + 4 * a' * c' ≤ 0 ∧ (∀(d, e, f)∈set a. ∃y'>(- b' + - 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a'). ∀x∈{(- b' + - 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a')<..y'}. d * x⇧2 + e * x + f = 0) ∧ (∀(d, e, f)∈set b. ∃y'>(- b' + - 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a'). ∀x∈{(- b' + - 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a')<..y'}. d * x⇧2 + e * x + f < 0) ∧ (∀(d, e, f)∈set c. ∃y'>(- b' + - 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a'). ∀x∈{(- b' + - 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a')<..y'}. d * x⇧2 + e * x + f ≤ 0) ∧ (∀(d, e, f)∈set d. ∃y'>(- b' + - 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a'). ∀x∈{(- b' + - 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a')<..y'}. d * x⇧2 + e * x + f ≠ 0)) ∧ ¬ (∃(a', b', c')∈set c. (a' = 0 ∧ b' ≠ 0) ∧ (∀(d, e, f)∈set a. d * (- c' / b')⇧2 + e * (- c' / b') + f = 0) ∧ (∀(d, e, f)∈set b. d * (- c' / b')⇧2 + e * (- c' / b') + f < 0) ∧ (∀(d, e, f)∈set c. d * (- c' / b')⇧2 + e * (- c' / b') + f ≤ 0) ∧ (∀(d, e, f)∈set d. d * (- c' / b')⇧2 + e * (- c' / b') + f ≠ 0)) ∧ ¬ (∃(a', b', c')∈set c. a' ≠ 0 ∧ - b'⇧2 + 4 * a' * c' ≤ 0 ∧ (∀(d, e, f)∈set a. d * ((- b' + 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a'))⇧2 + e * ((- b' + 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a')) + f = 0) ∧ (∀(d, e, f)∈set b. d * ((- b' + 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a'))⇧2 + e * ((- b' + 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a')) + f < 0) ∧ (∀(d, e, f)∈set c. d * ((- b' + 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a'))⇧2 + e * ((- b' + 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a')) + f ≤ 0) ∧ (∀(d, e, f)∈set d. d * ((- b' + 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a'))⇧2 + e * ((- b' + 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a')) + f ≠ 0)) ∧ ¬ (∃(a', b', c')∈set c. a' ≠ 0 ∧ - b'⇧2 + 4 * a' * c' ≤ 0 ∧ (∀(d, e, f)∈set a. d * ((- b' + - 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a'))⇧2 + e * ((- b' + - 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a')) + f = 0) ∧ (∀(d, e, f)∈set b. d * ((- b' + - 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a'))⇧2 + e * ((- b' + - 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a')) + f < 0) ∧ (∀(d, e, f)∈set c. d * ((- b' + - 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a'))⇧2 + e * ((- b' + - 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a')) + f ≤ 0) ∧ (∀(d, e, f)∈set d. d * ((- b' + - 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a'))⇧2 + e * ((- b' + - 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a')) + f ≠ 0)) ∧ ¬ (∃(a', b', c')∈set d. (a' = 0 ∧ b' ≠ 0) ∧ (∀(d, e, f)∈set a. ∃y'>- c' / b'. ∀x∈{- c' / b'<..y'}. d * x⇧2 + e * x + f = 0) ∧ (∀(d, e, f)∈set b. ∃y'>- c' / b'. ∀x∈{- c' / b'<..y'}. d * x⇧2 + e * x + f < 0) ∧ (∀(d, e, f)∈set c. ∃y'>- c' / b'. ∀x∈{- c' / b'<..y'}. d * x⇧2 + e * x + f ≤ 0) ∧ (∀(d, e, f)∈set d. ∃y'>- c' / b'. ∀x∈{- c' / b'<..y'}. d * x⇧2 + e * x + f ≠ 0)) ∧ ¬ (∃(a', b', c')∈set d. a' ≠ 0 ∧ - b'⇧2 + 4 * a' * c' ≤ 0 ∧ (∀(d, e, f)∈set a. ∃y'>(- b' + 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a'). ∀x∈{(- b' + 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a')<..y'}. d * x⇧2 + e * x + f = 0) ∧ (∀(d, e, f)∈set b. ∃y'>(- b' + 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a'). ∀x∈{(- b' + 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a')<..y'}. d * x⇧2 + e * x + f < 0) ∧ (∀(d, e, f)∈set c. ∃y'>(- b' + 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a'). ∀x∈{(- b' + 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a')<..y'}. d * x⇧2 + e * x + f ≤ 0) ∧ (∀(d, e, f)∈set d. ∃y'>(- b' + 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a'). ∀x∈{(- b' + 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a')<..y'}. d * x⇧2 + e * x + f ≠ 0)) ∧ ¬ (∃(a', b', c')∈set d. a' ≠ 0 ∧ - b'⇧2 + 4 * a' * c' ≤ 0 ∧ (∀(d, e, f)∈set a. ∃y'>(- b' + - 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a'). ∀x∈{(- b' + - 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a')<..y'}. d * x⇧2 + e * x + f = 0) ∧ (∀(d, e, f)∈set b. ∃y'>(- b' + - 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a'). ∀x∈{(- b' + - 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a')<..y'}. d * x⇧2 + e * x + f < 0) ∧ (∀(d, e, f)∈set c. ∃y'>(- b' + - 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a'). ∀x∈{(- b' + - 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a')<..y'}. d * x⇧2 + e * x + f ≤ 0) ∧ (∀(d, e, f)∈set d. ∃y'>(- b' + - 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a'). ∀x∈{(- b' + - 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a')<..y'}. d * x⇧2 + e * x + f ≠ 0))" have c1: "(∃ (d, e, f) ∈ set a. d ≠ 0 ∧ - e⇧2 + 4 * d * f ≤ 0) ⟹ False" proof - assume "(∃ (d, e, f) ∈ set a. d ≠ 0 ∧ - e⇧2 + 4 * d * f ≤ 0)" then obtain a' b' c' where abc_prop: "(a', b', c') ∈ set a ∧ a' ≠ 0 ∧ - b'⇧2 + 4 * a' * c' ≤ 0" by auto then have "a'*x^2 + b'*x + c' = 0" using x_prop by auto then have xis: "x = (- b' + - 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a') ∨ x = (- b' + 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a') " using abc_prop discriminant_nonneg[of a' b' c'] unfolding discrim_def by auto then have "((∀(d, e, f)∈set a. d * ((- b' + 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a'))⇧2 + e * ((- b' + 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a')) + f = 0) ∧ (∀(d, e, f)∈set b. d * ((- b' + 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a'))⇧2 + e * ((- b' + 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a')) + f < 0) ∧ (∀(d, e, f)∈set c. d * ((- b' + 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a'))⇧2 + e * ((- b' + 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a')) + f ≤ 0) ∧ (∀(d, e, f)∈set d. d * ((- b' + 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a'))⇧2 + e * ((- b' + 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a')) + f ≠ 0)) ∨ ((∀(d, e, f)∈set a. d * ((- b' + - 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a'))⇧2 + e * ((- b' + - 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a')) + f = 0) ∧ (∀(d, e, f)∈set b. d * ((- b' + - 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a'))⇧2 + e * ((- b' + - 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a')) + f < 0) ∧ (∀(d, e, f)∈set c. d * ((- b' + - 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a'))⇧2 + e * ((- b' + - 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a')) + f ≤ 0) ∧ (∀(d, e, f)∈set d. d * ((- b' + - 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a'))⇧2 + e * ((- b' + - 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a')) + f ≠ 0))" using x_prop by auto then have "(∃(a', b', c')∈set a. a' ≠ 0 ∧ - b'⇧2 + 4 * a' * c' ≤ 0 ∧ (∀(d, e, f)∈set a. d * ((- b' + 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a'))⇧2 + e * ((- b' + 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a')) + f = 0) ∧ (∀(d, e, f)∈set b. d * ((- b' + 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a'))⇧2 + e * ((- b' + 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a')) + f < 0) ∧ (∀(d, e, f)∈set c. d * ((- b' + 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a'))⇧2 + e * ((- b' + 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a')) + f ≤ 0) ∧ (∀(d, e, f)∈set d. d * ((- b' + 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a'))⇧2 + e * ((- b' + 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a')) + f ≠ 0)) ∨ (∃(a', b', c')∈set a. a' ≠ 0 ∧ - b'⇧2 + 4 * a' * c' ≤ 0 ∧ (∀(d, e, f)∈set a. d * ((- b' + - 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a'))⇧2 + e * ((- b' + - 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a')) + f = 0) ∧ (∀(d, e, f)∈set b. d * ((- b' + - 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a'))⇧2 + e * ((- b' + - 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a')) + f < 0) ∧ (∀(d, e, f)∈set c. d * ((- b' + - 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a'))⇧2 + e * ((- b' + - 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a')) + f ≤ 0) ∧ (∀(d, e, f)∈set d. d * ((- b' + - 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a'))⇧2 + e * ((- b' + - 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a')) + f ≠ 0))" using abc_prop xis by auto then show "False" using big_not by auto qed have c2: "(∃ (d, e, f) ∈ set a. d = 0 ∧ e ≠ 0) ⟹ False" proof - assume "(∃ (d, e, f) ∈ set a. d = 0 ∧ e ≠ 0)" then obtain a' b' c' where abc_prop: "(a', b', c') ∈ set a ∧ a' = 0 ∧ b' ≠ 0" by auto then have "a'*x^2 + b'*x + c' = 0" using x_prop by auto then have "b'*x + c' = 0" using abc_prop by auto then have xis: "x = - c' / b'" using abc_prop by (smt divide_non_zero) then have "(∀(d, e, f)∈set a. d * (- c' / b')⇧2 + e * (- c' / b') + f = 0) ∧ (∀(d, e, f)∈set b. d * (- c' / b')⇧2 + e * (- c' / b') + f < 0) ∧ (∀(d, e, f)∈set c. d * (- c' / b')⇧2 + e * (- c' / b') + f ≤ 0) ∧ (∀(d, e, f)∈set d. d * (- c' / b')⇧2 + e * (- c' / b') + f ≠ 0)" using x_prop by auto then have "(∃(a', b', c')∈set a. (a' = 0 ∧ b' ≠ 0) ∧ (∀(d, e, f)∈set a. d * (- c' / b')⇧2 + e * (- c' / b') + f = 0) ∧ (∀(d, e, f)∈set b. d * (- c' / b')⇧2 + e * (- c' / b') + f < 0) ∧ (∀(d, e, f)∈set c. d * (- c' / b')⇧2 + e * (- c' / b') + f ≤ 0) ∧ (∀(d, e, f)∈set d. d * (- c' / b')⇧2 + e * (- c' / b') + f ≠ 0))" using abc_prop xis by auto then show "False" using big_not by auto qed have c3: "(∀ (d, e, f) ∈ set a. d = 0 ∧ e = 0 ∧ f = 0) ⟹ False" proof - assume "(∀ (d, e, f) ∈ set a. d = 0 ∧ e = 0 ∧ f = 0)" then have equalset: "∀x. (∀(d, e, f)∈set a. d * x^2 + e * x + f = 0)" using case_prodE by auto have "¬?f5 ∧ ¬?f6 ∧ ¬?f7 ∧ ¬?f8 ∧ ¬?f13 ∧ ¬?f9 ∧ ¬?f10 ∧ ¬?f11 ∧ ¬?f12" using big_not by auto then have "¬(∃x. (∀(a, b, c)∈set b. a * x⇧2 + b * x + c < 0) ∧ (∀(a, b, c)∈set c. a * x⇧2 + b * x + c ≤ 0) ∧ (∀(a, b, c)∈set d. a * x⇧2 + b * x + c ≠ 0))" using equalset big_not qe_forwards_helper[of a b c d] by auto then show "False" using x_prop by auto qed have eo: "(∃ (d, e, f) ∈ set a. d ≠ 0 ∧ - e⇧2 + 4 * d * f ≤ 0) ∨ (∃ (d, e, f) ∈ set a. d = 0 ∧ e ≠ 0) ∨ (∀ (d, e, f) ∈ set a. d = 0 ∧ e = 0 ∧ f = 0)" proof - have "(∀ (d, e, f) ∈ set a. (d ≠ 0 ⟶ - e⇧2 + 4 * d * f ≤ 0))" proof clarsimp fix d e f assume in_set: " (d, e, f) ∈ set a" assume dnonz: "d ≠ 0" have "d*x^2 + e*x + f = 0" using in_set x_prop by auto then show " 4 * d * f ≤ e⇧2" using dnonz discriminant_negative[of d e f] unfolding discrim_def by fastforce qed then have discrim_prop: "¬(∃ (d, e, f) ∈ set a. d ≠ 0 ∧ - e⇧2 + 4 * d * f ≤ 0) ⟹ ¬(∃ (d, e, f) ∈ set a. d ≠ 0)" by auto have "¬(∃ (d, e, f) ∈ set a. d ≠ 0) ∧ ¬(∃ (d, e, f) ∈ set a. d = 0 ∧ e ≠ 0) ⟹ (∀ (d, e, f) ∈ set a. d = 0 ∧ e = 0 ∧ f = 0)" proof - assume ne: "¬(∃ (d, e, f) ∈ set a. d ≠ 0) ∧ ¬(∃ (d, e, f) ∈ set a. d = 0 ∧ e ≠ 0)" show "(∀ (d, e, f) ∈ set a. d = 0 ∧ e = 0 ∧ f = 0)" proof clarsimp fix d e f assume in_set: "(d, e, f) ∈set a" then have xzer: "d*x^2 + e*x + f = 0" using x_prop by auto have dzer: "d = 0" using ne in_set by auto have ezer: "e = 0" using ne in_set by auto show "d = 0 ∧ e = 0 ∧ f = 0" using xzer dzer ezer by auto qed qed then show ?thesis using discrim_prop by auto qed show "False" using c1 c2 c3 eo by auto qed then have " ¬?e2 ⟹ False" using bigor_var not_eq by presburger (* Takes a second *) then have " ¬?e2 ⟶ False" using impI[of "¬?e2" "False"] by blast then show ?thesis by auto qed subsubsection "Some Cases and Misc" lemma quadratic_linear : assumes "b≠0" assumes "a ≠ 0" assumes "4 * a * ba ≤ aa⇧2" assumes "b * (sqrt (aa⇧2 - 4 * a * ba) - aa) / (2 * a) + c = 0" assumes "∀x∈set eq. case x of (d, e, f) ⇒ d * ((sqrt (aa⇧2 - 4 * a * ba) - aa) / (2 * a))⇧2 + e * (sqrt (aa⇧2 - 4 * a * ba) - aa) / (2 * a) + f = 0" assumes "(aaa, aaaa, baa) ∈ set eq" shows "aaa * (c / b)⇧2 - aaaa * c / b + baa = 0" proof- have h: "-(c/b) = (sqrt (aa⇧2 - 4 * a * ba) - aa) / (2 * a)" using assms by (smt divide_minus_left nonzero_mult_div_cancel_left times_divide_eq_right) have h1 : "∀x∈set eq. case x of (d, e, f) ⇒ d * (c / b)⇧2 + e * - (c / b) + f = 0" using assms(5) unfolding h[symmetric] Fields.division_ring_class.times_divide_eq_right[symmetric] Power.ring_1_class.power2_minus . show ?thesis using bspec[OF h1 assms(6)] by simp qed lemma quadratic_linear1: assumes "b≠0" assumes "a ≠ 0" assumes "4 * a * ba ≤ aa⇧2" assumes "(b::real) * (sqrt ((aa::real)⇧2 - 4 * (a::real) * (ba::real)) - (aa::real)) / (2 * a) + (c::real) = 0" assumes " (∀x∈set (les::(real*real*real)list). case x of (d, e, f) ⇒ d * ((sqrt (aa⇧2 - 4 * a * ba) - aa) / (2 * a))⇧2 + e * (sqrt (aa⇧2 - 4 * a * ba) - aa) / (2 * a) + f < 0)" assumes "(aaa, aaaa, baa) ∈ set les" shows "aaa * (c / b)⇧2 - aaaa * c / b + baa < 0" proof- have h: "-(c/b) = (sqrt (aa⇧2 - 4 * a * ba) - aa) / (2 * a)" using assms by (smt divide_minus_left nonzero_mult_div_cancel_left times_divide_eq_right) have h1 : "∀x∈set les. case x of (d, e, f) ⇒ d * (c / b)⇧2 + e * - (c / b) + f < 0" using assms(5) unfolding h[symmetric] Fields.division_ring_class.times_divide_eq_right[symmetric] Power.ring_1_class.power2_minus . show ?thesis using bspec[OF h1 assms(6)] by simp qed lemma quadratic_linear2 : assumes "b≠0" assumes "a ≠ 0" assumes "4 * a * ba ≤ aa⇧2" assumes "b * (- aa -sqrt (aa⇧2 - 4 * a * ba)) / (2 * a) + c = 0" assumes "∀x∈set eq. case x of (d, e, f) ⇒ d * ((- aa -sqrt (aa⇧2 - 4 * a * ba)) / (2 * a))⇧2 + e * (- aa -sqrt (aa⇧2 - 4 * a * ba)) / (2 * a) + f = 0" assumes "(aaa, aaaa, baa) ∈ set eq" shows "aaa * (c / b)⇧2 - aaaa * c / b + baa = 0" proof- have h: "-((c::real)/(b::real)) = (- (aa::real) -sqrt (aa⇧2 - 4 * (a::real) * (ba::real))) / (2 * a)" using assms by (smt divide_minus_left nonzero_mult_div_cancel_left times_divide_eq_right) have h1 : "∀x∈set eq. case x of (d, e, f) ⇒ d * (c / b)⇧2 + e * - (c / b) + f = 0" using assms(5) unfolding h[symmetric] Fields.division_ring_class.times_divide_eq_right[symmetric] Power.ring_1_class.power2_minus . show ?thesis using bspec[OF h1 assms(6)] by simp qed lemma quadratic_linear3: assumes "b≠0" assumes "a ≠ 0" assumes "4 * a * ba ≤ aa⇧2" assumes "(b::real) * (- (aa::real)- sqrt ((aa::real)⇧2 - 4 * (a::real) * (ba::real)) ) / (2 * a) + (c::real) = 0" assumes "(∀x∈set (les::(real*real*real)list). case x of (d, e, f) ⇒ d * ((- aa - sqrt (aa⇧2 - 4 * a * ba)) / (2 * a))⇧2 + e * (- aa - sqrt (aa⇧2 - 4 * a * ba)) / (2 * a) + f < 0)" assumes "(aaa, aaaa, baa) ∈ set les" shows "aaa * (c / b)⇧2 - aaaa * c / b + baa < 0" proof- have h: "-((c::real)/(b::real)) = (- (aa::real) -sqrt (aa⇧2 - 4 * (a::real) * (ba::real))) / (2 * a)" using assms by (smt divide_minus_left nonzero_mult_div_cancel_left times_divide_eq_right) have h1 : "∀x∈set les. case x of (d, e, f) ⇒ d * (c / b)⇧2 + e * - (c / b) + f < 0" using assms(5) unfolding h[symmetric] Fields.division_ring_class.times_divide_eq_right[symmetric] Power.ring_1_class.power2_minus . show ?thesis using bspec[OF h1 assms(6)] by simp qed lemma h1b_helper_les: "(∀((a::real), (b::real), (c::real))∈set les. ∃x. ∀y<x. a * y⇧2 + b * y + c < 0) ⟹ (∃y.∀x<y. (∀(a, b, c)∈set les. a * x⇧2 + b * x + c < 0))" proof - show "(∀(a, b, c)∈set les. ∃x. ∀y<x. a * y⇧2 + b * y + c < 0) ⟹ (∃y.∀x<y. (∀(a, b, c)∈set les. a * x⇧2 + b * x + c < 0))" proof (induct les) case Nil then show ?case by auto next case (Cons q les) have ind: " ∀a∈set (q # les). case a of (a, ba, c) ⇒ ∃x. ∀y<x. a * y⇧2 + ba * y + c < 0" using Cons.prems by auto then have "case q of (a, ba, c) ⇒ ∃x. ∀y<x. a * y⇧2 + ba * y + c < 0 " by simp then obtain y2 where y2_prop: "case q of (a, ba, c) ⇒ (∀y<y2. a * y⇧2 + ba * y + c < 0)" by auto have "∀a∈set les. case a of (a, ba, c) ⇒ ∃x. ∀y<x. a * y⇧2 + ba * y + c < 0" using ind by simp then have " ∃y. ∀x<y. ∀a∈set les. case a of (a, ba, c) ⇒ a * x⇧2 + ba * x + c < 0" using Cons.hyps by blast then obtain y1 where y1_prop: "∀x<y1. ∀a∈set les. case a of (a, ba, c) ⇒ a * x^2 + ba * x + c < 0" by blast let ?y = "min y1 y2" have "∀x < ?y. (∀a∈set (q #les). case a of (a, ba, c) ⇒ a * x^2 + ba * x + c < 0)" using y1_prop y2_prop by fastforce then show ?case by blast qed qed lemma h1b_helper_leq: "(∀((a::real), (b::real), (c::real))∈set leq. ∃x. ∀y<x. a * y⇧2 + b * y + c ≤ 0) ⟹ (∃y.∀x<y. (∀(a, b, c)∈set leq. a * x⇧2 + b * x + c ≤ 0))" proof - show "(∀(a, b, c)∈set leq. ∃x. ∀y<x. a * y⇧2 + b * y + c ≤ 0) ⟹ (∃y.∀x<y. (∀(a, b, c)∈set leq. a * x⇧2 + b * x + c ≤ 0))" proof (induct leq) case Nil then show ?case by auto next case (Cons q leq) have ind: " ∀a∈set (q # leq). case a of (a, ba, c) ⇒ ∃x. ∀y<x. a * y⇧2 + ba * y + c ≤ 0" using Cons.prems by auto then have "case q of (a, ba, c) ⇒ ∃x. ∀y<x. a * y⇧2 + ba * y + c ≤ 0 " by simp then obtain y2 where y2_prop: "case q of (a, ba, c) ⇒ (∀y<y2. a * y⇧2 + ba * y + c ≤ 0)" by auto have "∀a∈set leq. case a of (a, ba, c) ⇒ ∃x. ∀y<x. a * y⇧2 + ba * y + c ≤ 0" using ind by simp then have " ∃y. ∀x<y. ∀a∈set leq. case a of (a, ba, c) ⇒ a * x⇧2 + ba * x + c ≤ 0" using Cons.hyps by blast then obtain y1 where y1_prop: "∀x<y1. ∀a∈set leq. case a of (a, ba, c) ⇒ a * x^2 + ba * x + c ≤ 0" by blast let ?y = "min y1 y2" have "∀x < ?y. (∀a∈set (q #leq). case a of (a, ba, c) ⇒ a * x^2 + ba * x + c ≤ 0)" using y1_prop y2_prop by fastforce then show ?case by blast qed qed lemma h1b_helper_neq: "(∀((a::real), (b::real), (c::real))∈set neq. ∃x. ∀y<x. a * y⇧2 + b * y + c ≠ 0) ⟹ (∃y.∀x<y. (∀(a, b, c)∈set neq. a * x⇧2 + b * x + c ≠ 0))" proof - show "(∀(a, b, c)∈set neq. ∃x. ∀y<x. a * y⇧2 + b * y + c ≠ 0) ⟹ (∃y.∀x<y. (∀(a, b, c)∈set neq. a * x⇧2 + b * x + c ≠ 0))" proof (induct neq) case Nil then show ?case by auto next case (Cons q neq) have ind: " ∀a∈set (q # neq). case a of (a, ba, c) ⇒ ∃x. ∀y<x. a * y⇧2 + ba * y + c ≠ 0" using Cons.prems by auto then have "case q of (a, ba, c) ⇒ ∃x. ∀y<x. a * y⇧2 + ba * y + c ≠ 0 " by simp then obtain y2 where y2_prop: "case q of (a, ba, c) ⇒ (∀y<y2. a * y⇧2 + ba * y + c ≠ 0)" by auto have "∀a∈set neq. case a of (a, ba, c) ⇒ ∃x. ∀y<x. a * y⇧2 + ba * y + c ≠ 0" using ind by simp then have " ∃y. ∀x<y. ∀a∈set neq. case a of (a, ba, c) ⇒ a * x⇧2 + ba * x + c ≠ 0" using Cons.hyps by blast then obtain y1 where y1_prop: "∀x<y1. ∀a∈set neq. case a of (a, ba, c) ⇒ a * x^2 + ba * x + c ≠ 0" by blast let ?y = "min y1 y2" have "∀x < ?y. (∀a∈set (q #neq). case a of (a, ba, c) ⇒ a * x^2 + ba * x + c ≠ 0)" using y1_prop y2_prop by fastforce then show ?case by blast qed qed lemma min_lem: fixes r::"real" assumes a1: "(∃y'>r. (∀((d::real), (e::real), (f::real))∈set b. ∀x∈{r<..y'}. d * x⇧2 + e * x + f < 0))" assumes a2: "(∃y'>r. (∀((d::real), (e::real), (f::real))∈set c. ∀x∈{r<..y'}. d * x⇧2 + e * x + f ≤ 0))" assumes a3: "(∃y'>r. (∀((d::real), (e::real), (f::real))∈set d. ∀x∈{r<..y'}. d * x⇧2 + e * x + f ≠ 0))" shows "(∃x. (∀(a, b, c)∈set b. a * x⇧2 + b * x + c < 0) ∧ (∀(a, b, c)∈set c. a * x⇧2 + b * x + c ≤ 0) ∧ (∀(a, b, c)∈set d. a * x⇧2 + b * x + c ≠ 0))" proof - obtain y1 where y1_prop: "y1 > r ∧ (∀(d, e, f)∈set b. ∀x∈{r<..y1}. d * x⇧2 + e * x + f < 0)" using a1 by auto obtain y2 where y2_prop: "y2 > r ∧ (∀(d, e, f)∈set c. ∀x∈{r<..y2}. d * x⇧2 + e * x + f ≤ 0)" using a2 by auto obtain y3 where y3_prop: "y3 > r ∧ (∀(d, e, f)∈set d. ∀x∈{r<..y3}. d * x⇧2 + e * x + f ≠ 0)" using a3 by auto let ?y = "(min (min y1 y2) y3)" have "?y > r" using y1_prop y2_prop y3_prop by auto then have "∃x. x > r ∧ x < ?y" using dense[of r ?y] by auto then obtain x where x_prop: "x > r ∧ x < ?y" by auto have bp: "(∀(a, b, c)∈set b. a *x⇧2 + b * x + c < 0)" using x_prop y1_prop by auto have cp: "(∀(a, b, c)∈set c. a * x^2 + b * x + c ≤ 0)" using x_prop y2_prop by auto have dp: "(∀(a, b, c)∈set d. a * x⇧2 + b * x + c ≠ 0)" using x_prop y3_prop by auto then have "(∀(a, b, c)∈set b. a * x⇧2 + b * x + c < 0) ∧ (∀(a, b, c)∈set c. a * x⇧2 + b * x + c ≤ 0) ∧ (∀(a, b, c)∈set d. a * x⇧2 + b * x + c ≠ 0)" using bp cp dp by auto then show ?thesis by auto qed lemma qe_infinitesimals_helper: fixes k::"real" assumes asm: "(∀(d, e, f)∈set a. ∃y'>k. ∀x∈{k<..y'}. d * x⇧2 + e * x + f = 0) ∧ (∀(d, e, f)∈set b. ∃y'>k. ∀x∈{k<..y'}. d * x⇧2 + e * x + f < 0) ∧ (∀(d, e, f)∈set c. ∃y'>k. ∀x∈{k<..y'}. d * x⇧2 + e * x + f ≤ 0) ∧ (∀(d, e, f)∈set d. ∃y'>k. ∀x∈{k<..y'}. d * x⇧2 + e * x + f ≠ 0)" shows "(∃x. (∀(a, b, c)∈set a. a * x⇧2 + b * x + c = 0) ∧ (∀(a, b, c)∈set b. a * x⇧2 + b * x + c < 0) ∧ (∀(a, b, c)∈set c. a * x⇧2 + b * x + c ≤ 0) ∧ (∀(a, b, c)∈set d. a * x⇧2 + b * x + c ≠ 0))" proof - have "∀(d, e, f)∈set a. d = 0 ∧ e = 0 ∧ f = 0" proof clarsimp fix d e f assume "(d, e, f) ∈ set a" then have "∃y'>k. ∀x∈{k<..y'}. d * x⇧2 + e * x + f = 0" using asm by auto then obtain y' where y_prop: "y'>k ∧ (∀x∈{k<..y'}. d * x⇧2 + e * x + f = 0)" by auto then show "d = 0 ∧ e = 0 ∧ f = 0" using continuity_lem_eq0[of "k" "y'" d e f] by auto qed then have eqprop: "∀x. (∀(a, b, c)∈set a. a * x⇧2 + b * x + c = 0) " by auto have lesprop: "(∃y'>k. (∀(d, e, f)∈set b. ∀x∈{k<..y'}. d * x⇧2 + e * x + f < 0))" using les_qe_inf_helper[of b "k"] asm by blast have leqprop: "(∃y'>k. (∀(d, e, f)∈set c. ∀x∈{(k)<..y'}. d * x⇧2 + e * x + f ≤ 0))" using leq_qe_inf_helper[of c "k"] asm by blast have neqprop: "(∃y'>(k). (∀(d, e, f)∈set d. ∀x∈{(k)<..y'}. d * x⇧2 + e * x + f ≠ 0))" using neq_qe_inf_helper[of d "k"] asm by blast then have "(∃x. (∀(a, b, c)∈set b. a * x⇧2 + b * x + c < 0) ∧ (∀(a, b, c)∈set c. a * x⇧2 + b * x + c ≤ 0) ∧ (∀(a, b, c)∈set d. a * x⇧2 + b * x + c ≠ 0)) " using lesprop leqprop neqprop min_lem[of "k" b c d] by auto then show ?thesis using eqprop by auto qed subsubsection "The qe\\_backwards lemma" lemma qe_backwards: assumes "(((∀(a, b, c)∈set a. a = 0 ∧ b = 0 ∧ c = 0) ∧ (∀(a, b, c)∈set b. ∃x. ∀y<x. a * y⇧2 + b * y + c < 0) ∧ (∀(a, b, c)∈set c. ∃x. ∀y<x. a * y⇧2 + b * y + c ≤ 0) ∧ (∀(a, b, c)∈set d. ∃x. ∀y<x. a * y⇧2 + b * y + c ≠ 0) ∨ (∃(a', b', c')∈set a. (a' = 0 ∧ b' ≠ 0) ∧ (∀(d, e, f)∈set a. d * (- c' / b')⇧2 + e * (- c' / b') + f = 0) ∧ (∀(d, e, f)∈set b. d * (- c' / b')⇧2 + e * (- c' / b') + f < 0) ∧ (∀(d, e, f)∈set c. d * (- c' / b')⇧2 + e * (- c' / b') + f ≤ 0) ∧ (∀(d, e, f)∈set d. d * (- c' / b')⇧2 + e * (- c' / b') + f ≠ 0) ∨ a' ≠ 0 ∧ - b'⇧2 + 4 * a' * c' ≤ 0 ∧ ((∀(d, e, f)∈set a. d * ((- b' + 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a'))⇧2 + e * ((- b' + 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a')) + f = 0) ∧ (∀(d, e, f)∈set b. d * ((- b' + 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a'))⇧2 + e * ((- b' + 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a')) + f < 0) ∧ (∀(d, e, f)∈set c. d * ((- b' + 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a'))⇧2 + e * ((- b' + 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a')) + f ≤ 0) ∧ (∀(d, e, f)∈set d. d * ((- b' + 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a'))⇧2 + e * ((- b' + 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a')) + f ≠ 0) ∨ (∀(d, e, f)∈set a. d * ((- b' + - 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a'))⇧2 + e * ((- b' + - 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a')) + f = 0) ∧ (∀(d, e, f)∈set b. d * ((- b' + - 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a'))⇧2 + e * ((- b' + - 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a')) + f < 0) ∧ (∀(d, e, f)∈set c. d * ((- b' + - 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a'))⇧2 + e * ((- b' + - 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a')) + f ≤ 0) ∧ (∀(d, e, f)∈set d. d * ((- b' + - 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a'))⇧2 + e * ((- b' + - 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a')) + f ≠ 0))) ∨ (∃(a', b', c')∈set b. (a' = 0 ∧ b' ≠ 0) ∧ (∀(d, e, f)∈set a. ∃y'>- c' / b'. ∀x∈{- c' / b'<..y'}. d * x⇧2 + e * x + f = 0) ∧ (∀(d, e, f)∈set b. ∃y'>- c' / b'. ∀x∈{- c' / b'<..y'}. d * x⇧2 + e * x + f < 0) ∧ (∀(d, e, f)∈set c. ∃y'>- c' / b'. ∀x∈{- c' / b'<..y'}. d * x⇧2 + e * x + f ≤ 0) ∧ (∀(d, e, f)∈set d. ∃y'>- c' / b'. ∀x∈{- c' / b'<..y'}. d * x⇧2 + e * x + f ≠ 0) ∨ a' ≠ 0 ∧ - b'⇧2 + 4 * a' * c' ≤ 0 ∧ ((∀(d, e, f)∈set a. ∃y'>(- b' + 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a'). ∀x∈{(- b' + 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a')<..y'}. d * x⇧2 + e * x + f = 0) ∧ (∀(d, e, f)∈set b. ∃y'>(- b' + 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a'). ∀x∈{(- b' + 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a')<..y'}. d * x⇧2 + e * x + f < 0) ∧ (∀(d, e, f)∈set c. ∃y'>(- b' + 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a'). ∀x∈{(- b' + 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a')<..y'}. d * x⇧2 + e * x + f ≤ 0) ∧ (∀(d, e, f)∈set d. ∃y'>(- b' + 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a'). ∀x∈{(- b' + 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a')<..y'}. d * x⇧2 + e * x + f ≠ 0) ∨ (∀(d, e, f)∈set a. ∃y'>(- b' + - 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a'). ∀x∈{(- b' + - 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a')<..y'}. d * x⇧2 + e * x + f = 0) ∧ (∀(d, e, f)∈set b. ∃y'>(- b' + - 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a'). ∀x∈{(- b' + - 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a')<..y'}. d * x⇧2 + e * x + f < 0) ∧ (∀(d, e, f)∈set c. ∃y'>(- b' + - 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a'). ∀x∈{(- b' + - 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a')<..y'}. d * x⇧2 + e * x + f ≤ 0) ∧ (∀(d, e, f)∈set d. ∃y'>(- b' + - 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a'). ∀x∈{(- b' + - 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a')<..y'}. d * x⇧2 + e * x + f ≠ 0))) ∨ (∃(a', b', c')∈set c. (a' = 0 ∧ b' ≠ 0) ∧ (∀(d, e, f)∈set a. d * (- c' / b')⇧2 + e * (- c' / b') + f = 0) ∧ (∀(d, e, f)∈set b. d * (- c' / b')⇧2 + e * (- c' / b') + f < 0) ∧ (∀(d, e, f)∈set c. d * (- c' / b')⇧2 + e * (- c' / b') + f ≤ 0) ∧ (∀(d, e, f)∈set d. d * (- c' / b')⇧2 + e * (- c' / b') + f ≠ 0) ∨ a' ≠ 0 ∧ - b'⇧2 + 4 * a' * c' ≤ 0 ∧ ((∀(d, e, f)∈set a. d * ((- b' + 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a'))⇧2 + e * ((- b' + 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a')) + f = 0) ∧ (∀(d, e, f)∈set b. d * ((- b' + 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a'))⇧2 + e * ((- b' + 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a')) + f < 0) ∧ (∀(d, e, f)∈set c. d * ((- b' + 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a'))⇧2 + e * ((- b' + 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a')) + f ≤ 0) ∧ (∀(d, e, f)∈set d. d * ((- b' + 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a'))⇧2 + e * ((- b' + 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a')) + f ≠ 0) ∨ (∀(d, e, f)∈set a. d * ((- b' + - 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a'))⇧2 + e * ((- b' + - 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a')) + f = 0) ∧ (∀(d, e, f)∈set b. d * ((- b' + - 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a'))⇧2 + e * ((- b' + - 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a')) + f < 0) ∧ (∀(d, e, f)∈set c. d * ((- b' + - 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a'))⇧2 + e * ((- b' + - 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a')) + f ≤ 0) ∧ (∀(d, e, f)∈set d. d * ((- b' + - 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a'))⇧2 + e * ((- b' + - 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a')) + f ≠ 0))) ∨ (∃(a', b', c')∈set d. (a' = 0 ∧ b' ≠ 0) ∧ (∀(d, e, f)∈set a. ∃y'>- c' / b'. ∀x∈{- c' / b'<..y'}. d * x⇧2 + e * x + f = 0) ∧ (∀(d, e, f)∈set b. ∃y'>- c' / b'. ∀x∈{- c' / b'<..y'}. d * x⇧2 + e * x + f < 0) ∧ (∀(d, e, f)∈set c. ∃y'>- c' / b'. ∀x∈{- c' / b'<..y'}. d * x⇧2 + e * x + f ≤ 0) ∧ (∀(d, e, f)∈set d. ∃y'>- c' / b'. ∀x∈{- c' / b'<..y'}. d * x⇧2 + e * x + f ≠ 0) ∨ a' ≠ 0 ∧ - b'⇧2 + 4 * a' * c' ≤ 0 ∧ ((∀(d, e, f)∈set a. ∃y'>(- b' + 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a'). ∀x∈{(- b' + 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a')<..y'}. d * x⇧2 + e * x + f = 0) ∧ (∀(d, e, f)∈set b. ∃y'>(- b' + 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a'). ∀x∈{(- b' + 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a')<..y'}. d * x⇧2 + e * x + f < 0) ∧ (∀(d, e, f)∈set c. ∃y'>(- b' + 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a'). ∀x∈{(- b' + 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a')<..y'}. d * x⇧2 + e * x + f ≤ 0) ∧ (∀(d, e, f)∈set d. ∃y'>(- b' + 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a'). ∀x∈{(- b' + 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a')<..y'}. d * x⇧2 + e * x + f ≠ 0) ∨ (∀(d, e, f)∈set a. ∃y'>(- b' + - 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a'). ∀x∈{(- b' + - 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a')<..y'}. d * x⇧2 + e * x + f = 0) ∧ (∀(d, e, f)∈set b. ∃y'>(- b' + - 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a'). ∀x∈{(- b' + - 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a')<..y'}. d * x⇧2 + e * x + f < 0) ∧ (∀(d, e, f)∈set c. ∃y'>(- b' + - 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a'). ∀x∈{(- b' + - 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a')<..y'}. d * x⇧2 + e * x + f ≤ 0) ∧ (∀(d, e, f)∈set d. ∃y'>(- b' + - 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a'). ∀x∈{(- b' + - 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a')<..y'}. d * x⇧2 + e * x + f ≠ 0)))))" shows " (∃x. (∀(a, b, c)∈set a. a * x⇧2 + b * x + c = 0) ∧ (∀(a, b, c)∈set b. a * x⇧2 + b * x + c < 0) ∧ (∀(a, b, c)∈set c. a * x⇧2 + b * x + c ≤ 0) ∧ (∀(a, b, c)∈set d. a * x⇧2 + b * x + c ≠ 0))" proof - let ?e2 = "(((∀(a, b, c)∈set a. a = 0 ∧ b = 0 ∧ c = 0) ∧ (∀(a, b, c)∈set b. ∃x. ∀y<x. a * y⇧2 + b * y + c < 0) ∧ (∀(a, b, c)∈set c. ∃x. ∀y<x. a * y⇧2 + b * y + c ≤ 0) ∧ (∀(a, b, c)∈set d. ∃x. ∀y<x. a * y⇧2 + b * y + c ≠ 0) ∨ (∃(a', b', c')∈set a. (a' = 0 ∧ b' ≠ 0) ∧ (∀(d, e, f)∈set a. d * (- c' / b')⇧2 + e * (- c' / b') + f = 0) ∧ (∀(d, e, f)∈set b. d * (- c' / b')⇧2 + e * (- c' / b') + f < 0) ∧ (∀(d, e, f)∈set c. d * (- c' / b')⇧2 + e * (- c' / b') + f ≤ 0) ∧ (∀(d, e, f)∈set d. d * (- c' / b')⇧2 + e * (- c' / b') + f ≠ 0) ∨ a' ≠ 0 ∧ - b'⇧2 + 4 * a' * c' ≤ 0 ∧ ((∀(d, e, f)∈set a. d * ((- b' + 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a'))⇧2 + e * ((- b' + 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a')) + f = 0) ∧ (∀(d, e, f)∈set b. d * ((- b' + 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a'))⇧2 + e * ((- b' + 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a')) + f < 0) ∧ (∀(d, e, f)∈set c. d * ((- b' + 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a'))⇧2 + e * ((- b' + 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a')) + f ≤ 0) ∧ (∀(d, e, f)∈set d. d * ((- b' + 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a'))⇧2 + e * ((- b' + 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a')) + f ≠ 0) ∨ (∀(d, e, f)∈set a. d * ((- b' + - 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a'))⇧2 + e * ((- b' + - 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a')) + f = 0) ∧ (∀(d, e, f)∈set b. d * ((- b' + - 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a'))⇧2 + e * ((- b' + - 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a')) + f < 0) ∧ (∀(d, e, f)∈set c. d * ((- b' + - 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a'))⇧2 + e * ((- b' + - 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a')) + f ≤ 0) ∧ (∀(d, e, f)∈set d. d * ((- b' + - 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a'))⇧2 + e * ((- b' + - 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a')) + f ≠ 0))) ∨ (∃(a', b', c')∈set b. (a' = 0 ∧ b' ≠ 0) ∧ (∀(d, e, f)∈set a. ∃y'>- c' / b'. ∀x∈{- c' / b'<..y'}. d * x⇧2 + e * x + f = 0) ∧ (∀(d, e, f)∈set b. ∃y'>- c' / b'. ∀x∈{- c' / b'<..y'}. d * x⇧2 + e * x + f < 0) ∧ (∀(d, e, f)∈set c. ∃y'>- c' / b'. ∀x∈{- c' / b'<..y'}. d * x⇧2 + e * x + f ≤ 0) ∧ (∀(d, e, f)∈set d. ∃y'>- c' / b'. ∀x∈{- c' / b'<..y'}. d * x⇧2 + e * x + f ≠ 0) ∨ a' ≠ 0 ∧ - b'⇧2 + 4 * a' * c' ≤ 0 ∧ ((∀(d, e, f)∈set a. ∃y'>(- b' + 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a'). ∀x∈{(- b' + 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a')<..y'}. d * x⇧2 + e * x + f = 0) ∧ (∀(d, e, f)∈set b. ∃y'>(- b' + 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a'). ∀x∈{(- b' + 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a')<..y'}. d * x⇧2 + e * x + f < 0) ∧ (∀(d, e, f)∈set c. ∃y'>(- b' + 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a'). ∀x∈{(- b' + 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a')<..y'}. d * x⇧2 + e * x + f ≤ 0) ∧ (∀(d, e, f)∈set d. ∃y'>(- b' + 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a'). ∀x∈{(- b' + 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a')<..y'}. d * x⇧2 + e * x + f ≠ 0) ∨ (∀(d, e, f)∈set a. ∃y'>(- b' + - 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a'). ∀x∈{(- b' + - 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a')<..y'}. d * x⇧2 + e * x + f = 0) ∧ (∀(d, e, f)∈set b. ∃y'>(- b' + - 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a'). ∀x∈{(- b' + - 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a')<..y'}. d * x⇧2 + e * x + f < 0) ∧ (∀(d, e, f)∈set c. ∃y'>(- b' + - 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a'). ∀x∈{(- b' + - 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a')<..y'}. d * x⇧2 + e * x + f ≤ 0) ∧ (∀(d, e, f)∈set d. ∃y'>(- b' + - 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a'). ∀x∈{(- b' + - 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a')<..y'}. d * x⇧2 + e * x + f ≠ 0))) ∨ (∃(a', b', c')∈set c. (a' = 0 ∧ b' ≠ 0) ∧ (∀(d, e, f)∈set a. d * (- c' / b')⇧2 + e * (- c' / b') + f = 0) ∧ (∀(d, e, f)∈set b. d * (- c' / b')⇧2 + e * (- c' / b') + f < 0) ∧ (∀(d, e, f)∈set c. d * (- c' / b')⇧2 + e * (- c' / b') + f ≤ 0) ∧ (∀(d, e, f)∈set d. d * (- c' / b')⇧2 + e * (- c' / b') + f ≠ 0) ∨ a' ≠ 0 ∧ - b'⇧2 + 4 * a' * c' ≤ 0 ∧ ((∀(d, e, f)∈set a. d * ((- b' + 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a'))⇧2 + e * ((- b' + 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a')) + f = 0) ∧ (∀(d, e, f)∈set b. d * ((- b' + 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a'))⇧2 + e * ((- b' + 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a')) + f < 0) ∧ (∀(d, e, f)∈set c. d * ((- b' + 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a'))⇧2 + e * ((- b' + 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a')) + f ≤ 0) ∧ (∀(d, e, f)∈set d. d * ((- b' + 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a'))⇧2 + e * ((- b' + 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a')) + f ≠ 0) ∨ (∀(d, e, f)∈set a. d * ((- b' + - 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a'))⇧2 + e * ((- b' + - 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a')) + f = 0) ∧ (∀(d, e, f)∈set b. d * ((- b' + - 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a'))⇧2 + e * ((- b' + - 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a')) + f < 0) ∧ (∀(d, e, f)∈set c. d * ((- b' + - 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a'))⇧2 + e * ((- b' + - 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a')) + f ≤ 0) ∧ (∀(d, e, f)∈set d. d * ((- b' + - 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a'))⇧2 + e * ((- b' + - 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a')) + f ≠ 0))) ∨ (∃(a', b', c')∈set d. (a' = 0 ∧ b' ≠ 0) ∧ (∀(d, e, f)∈set a. ∃y'>- c' / b'. ∀x∈{- c' / b'<..y'}. d * x⇧2 + e * x + f = 0) ∧ (∀(d, e, f)∈set b. ∃y'>- c' / b'. ∀x∈{- c' / b'<..y'}. d * x⇧2 + e * x + f < 0) ∧ (∀(d, e, f)∈set c. ∃y'>- c' / b'. ∀x∈{- c' / b'<..y'}. d * x⇧2 + e * x + f ≤ 0) ∧ (∀(d, e, f)∈set d. ∃y'>- c' / b'. ∀x∈{- c' / b'<..y'}. d * x⇧2 + e * x + f ≠ 0) ∨ a' ≠ 0 ∧ - b'⇧2 + 4 * a' * c' ≤ 0 ∧ ((∀(d, e, f)∈set a. ∃y'>(- b' + 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a'). ∀x∈{(- b' + 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a')<..y'}. d * x⇧2 + e * x + f = 0) ∧ (∀(d, e, f)∈set b. ∃y'>(- b' + 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a'). ∀x∈{(- b' + 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a')<..y'}. d * x⇧2 + e * x + f < 0) ∧ (∀(d, e, f)∈set c. ∃y'>(- b' + 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a'). ∀x∈{(- b' + 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a')<..y'}. d * x⇧2 + e * x + f ≤ 0) ∧ (∀(d, e, f)∈set d. ∃y'>(- b' + 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a'). ∀x∈{(- b' + 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a')<..y'}. d * x⇧2 + e * x + f ≠ 0) ∨ (∀(d, e, f)∈set a. ∃y'>(- b' + - 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a'). ∀x∈{(- b' + - 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a')<..y'}. d * x⇧2 + e * x + f = 0) ∧ (∀(d, e, f)∈set b. ∃y'>(- b' + - 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a'). ∀x∈{(- b' + - 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a')<..y'}. d * x⇧2 + e * x + f < 0) ∧ (∀(d, e, f)∈set c. ∃y'>(- b' + - 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a'). ∀x∈{(- b' + - 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a')<..y'}. d * x⇧2 + e * x + f ≤ 0) ∧ (∀(d, e, f)∈set d. ∃y'>(- b' + - 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a'). ∀x∈{(- b' + - 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a')<..y'}. d * x⇧2 + e * x + f ≠ 0)))))" let ?f10orf11orf12 = "(∃(a', b', c')∈set d. (a' = 0 ∧ b' ≠ 0) ∧ (∀(d, e, f)∈set a. ∃y'>- c' / b'. ∀x∈{- c' / b'<..y'}. d * x⇧2 + e * x + f = 0) ∧ (∀(d, e, f)∈set b. ∃y'>- c' / b'. ∀x∈{- c' / b'<..y'}. d * x⇧2 + e * x + f < 0) ∧ (∀(d, e, f)∈set c. ∃y'>- c' / b'. ∀x∈{- c' / b'<..y'}. d * x⇧2 + e * x + f ≤ 0) ∧ (∀(d, e, f)∈set d. ∃y'>- c' / b'. ∀x∈{- c' / b'<..y'}. d * x⇧2 + e * x + f ≠ 0) ∨ a' ≠ 0 ∧ - b'⇧2 + 4 * a' * c' ≤ 0 ∧ ((∀(d, e, f)∈set a. ∃y'>(- b' + 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a'). ∀x∈{(- b' + 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a')<..y'}. d * x⇧2 + e * x + f = 0) ∧ (∀(d, e, f)∈set b. ∃y'>(- b' + 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a'). ∀x∈{(- b' + 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a')<..y'}. d * x⇧2 + e * x + f < 0) ∧ (∀(d, e, f)∈set c. ∃y'>(- b' + 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a'). ∀x∈{(- b' + 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a')<..y'}. d * x⇧2 + e * x + f ≤ 0) ∧ (∀(d, e, f)∈set d. ∃y'>(- b' + 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a'). ∀x∈{(- b' + 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a')<..y'}. d * x⇧2 + e * x + f ≠ 0) ∨ (∀(d, e, f)∈set a. ∃y'>(- b' + - 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a'). ∀x∈{(- b' + - 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a')<..y'}. d * x⇧2 + e * x + f = 0) ∧ (∀(d, e, f)∈set b. ∃y'>(- b' + - 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a'). ∀x∈{(- b' + - 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a')<..y'}. d * x⇧2 + e * x + f < 0) ∧ (∀(d, e, f)∈set c. ∃y'>(- b' + - 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a'). ∀x∈{(- b' + - 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a')<..y'}. d * x⇧2 + e * x + f ≤ 0) ∧ (∀(d, e, f)∈set d. ∃y'>(- b' + - 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a'). ∀x∈{(- b' + - 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a')<..y'}. d * x⇧2 + e * x + f ≠ 0)))" let ?f8orf9 = "(∃(a', b', c')∈set c. (a' = 0 ∧ b' ≠ 0) ∧ (∀(d, e, f)∈set a. d * (- c' / b')⇧2 + e * (- c' / b') + f = 0) ∧ (∀(d, e, f)∈set b. d * (- c' / b')⇧2 + e * (- c' / b') + f < 0) ∧ (∀(d, e, f)∈set c. d * (- c' / b')⇧2 + e * (- c' / b') + f ≤ 0) ∧ (∀(d, e, f)∈set d. d * (- c' / b')⇧2 + e * (- c' / b') + f ≠ 0) ∨ a' ≠ 0 ∧ - b'⇧2 + 4 * a' * c' ≤ 0 ∧ ((∀(d, e, f)∈set a. d * ((- b' + 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a'))⇧2 + e * ((- b' + 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a')) + f = 0) ∧ (∀(d, e, f)∈set b. d * ((- b' + 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a'))⇧2 + e * ((- b' + 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a')) + f < 0) ∧ (∀(d, e, f)∈set c. d * ((- b' + 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a'))⇧2 + e * ((- b' + 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a')) + f ≤ 0) ∧ (∀(d, e, f)∈set d. d * ((- b' + 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a'))⇧2 + e * ((- b' + 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a')) + f ≠ 0) ∨ (∀(d, e, f)∈set a. d * ((- b' + - 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a'))⇧2 + e * ((- b' + - 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a')) + f = 0) ∧ (∀(d, e, f)∈set b. d * ((- b' + - 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a'))⇧2 + e * ((- b' + - 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a')) + f < 0) ∧ (∀(d, e, f)∈set c. d * ((- b' + - 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a'))⇧2 + e * ((- b' + - 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a')) + f ≤ 0) ∧ (∀(d, e, f)∈set d. d * ((- b' + - 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a'))⇧2 + e * ((- b' + - 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a')) + f ≠ 0)))" let ?f5orf6orf7 = "(∃(a', b', c')∈set b. (a' = 0 ∧ b' ≠ 0) ∧ (∀(d, e, f)∈set a. ∃y'>- c' / b'. ∀x∈{- c' / b'<..y'}. d * x⇧2 + e * x + f = 0) ∧ (∀(d, e, f)∈set b. ∃y'>- c' / b'. ∀x∈{- c' / b'<..y'}. d * x⇧2 + e * x + f < 0) ∧ (∀(d, e, f)∈set c. ∃y'>- c' / b'. ∀x∈{- c' / b'<..y'}. d * x⇧2 + e * x + f ≤ 0) ∧ (∀(d, e, f)∈set d. ∃y'>- c' / b'. ∀x∈{- c' / b'<..y'}. d * x⇧2 + e * x + f ≠ 0) ∨ a' ≠ 0 ∧ - b'⇧2 + 4 * a' * c' ≤ 0 ∧ ((∀(d, e, f)∈set a. ∃y'>(- b' + 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a'). ∀x∈{(- b' + 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a')<..y'}. d * x⇧2 + e * x + f = 0) ∧ (∀(d, e, f)∈set b. ∃y'>(- b' + 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a'). ∀x∈{(- b' + 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a')<..y'}. d * x⇧2 + e * x + f < 0) ∧ (∀(d, e, f)∈set c. ∃y'>(- b' + 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a'). ∀x∈{(- b' + 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a')<..y'}. d * x⇧2 + e * x + f ≤ 0) ∧ (∀(d, e, f)∈set d. ∃y'>(- b' + 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a'). ∀x∈{(- b' + 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a')<..y'}. d * x⇧2 + e * x + f ≠ 0) ∨ (∀(d, e, f)∈set a. ∃y'>(- b' + - 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a'). ∀x∈{(- b' + - 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a')<..y'}. d * x⇧2 + e * x + f = 0) ∧ (∀(d, e, f)∈set b. ∃y'>(- b' + - 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a'). ∀x∈{(- b' + - 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a')<..y'}. d * x⇧2 + e * x + f < 0) ∧ (∀(d, e, f)∈set c. ∃y'>(- b' + - 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a'). ∀x∈{(- b' + - 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a')<..y'}. d * x⇧2 + e * x + f ≤ 0) ∧ (∀(d, e, f)∈set d. ∃y'>(- b' + - 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a'). ∀x∈{(- b' + - 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a')<..y'}. d * x⇧2 + e * x + f ≠ 0)))" let ?f2orf3orf4 = "(∃(a', b', c')∈set a. (a' = 0 ∧ b' ≠ 0) ∧ (∀(d, e, f)∈set a. d * (- c' / b')⇧2 + e * (- c' / b') + f = 0) ∧ (∀(d, e, f)∈set b. d * (- c' / b')⇧2 + e * (- c' / b') + f < 0) ∧ (∀(d, e, f)∈set c. d * (- c' / b')⇧2 + e * (- c' / b') + f ≤ 0) ∧ (∀(d, e, f)∈set d. d * (- c' / b')⇧2 + e * (- c' / b') + f ≠ 0) ∨ a' ≠ 0 ∧ - b'⇧2 + 4 * a' * c' ≤ 0 ∧ ((∀(d, e, f)∈set a. d * ((- b' + 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a'))⇧2 + e * ((- b' + 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a')) + f = 0) ∧ (∀(d, e, f)∈set b. d * ((- b' + 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a'))⇧2 + e * ((- b' + 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a')) + f < 0) ∧ (∀(d, e, f)∈set c. d * ((- b' + 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a'))⇧2 + e * ((- b' + 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a')) + f ≤ 0) ∧ (∀(d, e, f)∈set d. d * ((- b' + 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a'))⇧2 + e * ((- b' + 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a')) + f ≠ 0) ∨ (∀(d, e, f)∈set a. d * ((- b' + - 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a'))⇧2 + e * ((- b' + - 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a')) + f = 0) ∧ (∀(d, e, f)∈set b. d * ((- b' + - 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a'))⇧2 + e * ((- b' + - 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a')) + f < 0) ∧ (∀(d, e, f)∈set c. d * ((- b' + - 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a'))⇧2 + e * ((- b' + - 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a')) + f ≤ 0) ∧ (∀(d, e, f)∈set d. d * ((- b' + - 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a'))⇧2 + e * ((- b' + - 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a')) + f ≠ 0)))" let ?e1 = "(∃x. (∀(a, b, c)∈set a. a * x⇧2 + b * x + c = 0) ∧ (∀(a, b, c)∈set b. a * x⇧2 + b * x + c < 0) ∧ (∀(a, b, c)∈set c. a * x⇧2 + b * x + c ≤ 0) ∧ (∀(a, b, c)∈set d. a * x⇧2 + b * x + c ≠ 0))" let ?f1 = "((∀(a, b, c)∈set a. a = 0 ∧ b = 0 ∧ c = 0) ∧ (∀(a, b, c)∈set b. ∃x. ∀y<x. a * y⇧2 + b * y + c < 0) ∧ (∀(a, b, c)∈set c. ∃x. ∀y<x. a * y⇧2 + b * y + c ≤ 0) ∧ (∀(a, b, c)∈set d. ∃x. ∀y<x. a * y⇧2 + b * y + c ≠ 0))" let ?f2 = "(∃(a', b', c')∈set a. (a' = 0 ∧ b' ≠ 0) ∧ (∀(d, e, f)∈set a. d * (- c' / b')⇧2 + e * (- c' / b') + f = 0) ∧ (∀(d, e, f)∈set b. d * (- c' / b')⇧2 + e * (- c' / b') + f < 0) ∧ (∀(d, e, f)∈set c. d * (- c' / b')⇧2 + e * (- c' / b') + f ≤ 0) ∧ (∀(d, e, f)∈set d. d * (- c' / b')⇧2 + e * (- c' / b') + f ≠ 0))" let ?f3 = "(∃(a', b', c')∈set a. a' ≠ 0 ∧ - b'⇧2 + 4 * a' * c' ≤ 0 ∧ (∀(d, e, f)∈set a. d * ((- b' + 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a'))⇧2 + e * ((- b' + 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a')) + f = 0) ∧ (∀(d, e, f)∈set b. d * ((- b' + 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a'))⇧2 + e * ((- b' + 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a')) + f < 0) ∧ (∀(d, e, f)∈set c. d * ((- b' + 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a'))⇧2 + e * ((- b' + 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a')) + f ≤ 0) ∧ (∀(d, e, f)∈set d. d * ((- b' + 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a'))⇧2 + e * ((- b' + 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a')) + f ≠ 0))" let ?f4 = "(∃(a', b', c')∈set a. a' ≠ 0 ∧ - b'⇧2 + 4 * a' * c' ≤ 0 ∧ (∀(d, e, f)∈set a. d * ((- b' + - 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a'))⇧2 + e * ((- b' + - 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a')) + f = 0) ∧ (∀(d, e, f)∈set b. d * ((- b' + - 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a'))⇧2 + e * ((- b' + - 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a')) + f < 0) ∧ (∀(d, e, f)∈set c. d * ((- b' + - 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a'))⇧2 + e * ((- b' + - 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a')) + f ≤ 0) ∧ (∀(d, e, f)∈set d. d * ((- b' + - 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a'))⇧2 + e * ((- b' + - 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a')) + f ≠ 0)) " let ?f5 = "(∃(a', b', c')∈set b. (a' = 0 ∧ b' ≠ 0) ∧ (∀(d, e, f)∈set a. ∃y'>- c' / b'. ∀x∈{- c' / b'<..y'}. d * x⇧2 + e * x + f = 0) ∧ (∀(d, e, f)∈set b. ∃y'>- c' / b'. ∀x∈{- c' / b'<..y'}. d * x⇧2 + e * x + f < 0) ∧ (∀(d, e, f)∈set c. ∃y'>- c' / b'. ∀x∈{- c' / b'<..y'}. d * x⇧2 + e * x + f ≤ 0) ∧ (∀(d, e, f)∈set d. ∃y'>- c' / b'. ∀x∈{- c' / b'<..y'}. d * x⇧2 + e * x + f ≠ 0))" let ?f6 = "(∃(a', b', c')∈set b. a' ≠ 0 ∧ - b'⇧2 + 4 * a' * c' ≤ 0 ∧ ((∀(d, e, f)∈set a. ∃y'>(- b' + 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a'). ∀x∈{(- b' + 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a')<..y'}. d * x⇧2 + e * x + f = 0) ∧ (∀(d, e, f)∈set b. ∃y'>(- b' + 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a'). ∀x∈{(- b' + 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a')<..y'}. d * x⇧2 + e * x + f < 0) ∧ (∀(d, e, f)∈set c. ∃y'>(- b' + 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a'). ∀x∈{(- b' + 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a')<..y'}. d * x⇧2 + e * x + f ≤ 0) ∧ (∀(d, e, f)∈set d. ∃y'>(- b' + 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a'). ∀x∈{(- b' + 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a')<..y'}. d * x⇧2 + e * x + f ≠ 0)))" let ?f7 = "(∃(a', b', c')∈set b. a' ≠ 0 ∧ - b'⇧2 + 4 * a' * c' ≤ 0 ∧ (∀(d, e, f)∈set a. ∃y'>(- b' + - 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a'). ∀x∈{(- b' + - 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a')<..y'}. d * x⇧2 + e * x + f = 0) ∧ (∀(d, e, f)∈set b. ∃y'>(- b' + - 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a'). ∀x∈{(- b' + - 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a')<..y'}. d * x⇧2 + e * x + f < 0) ∧ (∀(d, e, f)∈set c. ∃y'>(- b' + - 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a'). ∀x∈{(- b' + - 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a')<..y'}. d * x⇧2 + e * x + f ≤ 0) ∧ (∀(d, e, f)∈set d. ∃y'>(- b' + - 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a'). ∀x∈{(- b' + - 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a')<..y'}. d * x⇧2 + e * x + f ≠ 0))" let ?f8 = "(∃(a', b', c')∈set c. (a' = 0 ∧ b' ≠ 0) ∧ (∀(d, e, f)∈set a. d * (- c' / b')⇧2 + e * (- c' / b') + f = 0) ∧ (∀(d, e, f)∈set b. d * (- c' / b')⇧2 + e * (- c' / b') + f < 0) ∧ (∀(d, e, f)∈set c. d * (- c' / b')⇧2 + e * (- c' / b') + f ≤ 0) ∧ (∀(d, e, f)∈set d. d * (- c' / b')⇧2 + e * (- c' / b') + f ≠ 0))" let ?f13 = "(∃(a', b', c')∈set c. a' ≠ 0 ∧ - b'⇧2 + 4 * a' * c' ≤ 0 ∧ ((∀(d, e, f)∈set a. d * ((- b' + 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a'))⇧2 + e * ((- b' + 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a')) + f = 0) ∧ (∀(d, e, f)∈set b. d * ((- b' + 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a'))⇧2 + e * ((- b' + 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a')) + f < 0) ∧ (∀(d, e, f)∈set c. d * ((- b' + 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a'))⇧2 + e * ((- b' + 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a')) + f ≤ 0) ∧ (∀(d, e, f)∈set d. d * ((- b' + 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a'))⇧2 + e * ((- b' + 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a')) + f ≠ 0)))" let ?f9 = "(∃(a', b', c')∈set c. a' ≠ 0 ∧ - b'⇧2 + 4 * a' * c' ≤ 0 ∧ (∀(d, e, f)∈set a. d * ((- b' + - 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a'))⇧2 + e * ((- b' + - 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a')) + f = 0) ∧ (∀(d, e, f)∈set b. d * ((- b' + - 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a'))⇧2 + e * ((- b' + - 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a')) + f < 0) ∧ (∀(d, e, f)∈set c. d * ((- b' + - 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a'))⇧2 + e * ((- b' + - 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a')) + f ≤ 0) ∧ (∀(d, e, f)∈set d. d * ((- b' + - 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a'))⇧2 + e * ((- b' + - 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a')) + f ≠ 0))" let ?f10 = "(∃(a', b', c')∈set d. (a' = 0 ∧ b' ≠ 0) ∧ (∀(d, e, f)∈set a. ∃y'>- c' / b'. ∀x∈{- c' / b'<..y'}. d * x⇧2 + e * x + f = 0) ∧ (∀(d, e, f)∈set b. ∃y'>- c' / b'. ∀x∈{- c' / b'<..y'}. d * x⇧2 + e * x + f < 0) ∧ (∀(d, e, f)∈set c. ∃y'>- c' / b'. ∀x∈{- c' / b'<..y'}. d * x⇧2 + e * x + f ≤ 0) ∧ (∀(d, e, f)∈set d. ∃y'>- c' / b'. ∀x∈{- c' / b'<..y'}. d * x⇧2 + e * x + f ≠ 0))" let ?f11 = "(∃(a', b', c')∈set d. a' ≠ 0 ∧ - b'⇧2 + 4 * a' * c' ≤ 0 ∧ ((∀(d, e, f)∈set a. ∃y'>(- b' + 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a'). ∀x∈{(- b' + 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a')<..y'}. d * x⇧2 + e * x + f = 0) ∧ (∀(d, e, f)∈set b. ∃y'>(- b' + 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a'). ∀x∈{(- b' + 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a')<..y'}. d * x⇧2 + e * x + f < 0) ∧ (∀(d, e, f)∈set c. ∃y'>(- b' + 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a'). ∀x∈{(- b' + 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a')<..y'}. d * x⇧2 + e * x + f ≤ 0) ∧ (∀(d, e, f)∈set d. ∃y'>(- b' + 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a'). ∀x∈{(- b' + 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a')<..y'}. d * x⇧2 + e * x + f ≠ 0)))" let ?f12 = "(∃(a', b', c')∈set d. a' ≠ 0 ∧ - b'⇧2 + 4 * a' * c' ≤ 0 ∧ (∀(d, e, f)∈set a. ∃y'>(- b' + - 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a'). ∀x∈{(- b' + - 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a')<..y'}. d * x⇧2 + e * x + f = 0) ∧ (∀(d, e, f)∈set b. ∃y'>(- b' + - 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a'). ∀x∈{(- b' + - 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a')<..y'}. d * x⇧2 + e * x + f < 0) ∧ (∀(d, e, f)∈set c. ∃y'>(- b' + - 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a'). ∀x∈{(- b' + - 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a')<..y'}. d * x⇧2 + e * x + f ≤ 0) ∧ (∀(d, e, f)∈set d. ∃y'>(- b' + - 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a'). ∀x∈{(- b' + - 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a')<..y'}. d * x⇧2 + e * x + f ≠ 0))" have h1a: "?e2 ⟶ (?f1 ∨ ?f2orf3orf4 ∨ ?f5orf6orf7 ∨ ?f8orf9 ∨ ?f10orf11orf12)" by auto have h2: "?f2orf3orf4 ⟶ (?f2 ∨ ?f3 ∨ ?f4)" by auto then have h1b: "?e2 ⟶ (?f1 ∨ ?f2 ∨ ?f3 ∨ ?f4 ∨ ?f5orf6orf7 ∨ ?f8orf9 ∨ ?f10orf11orf12) " using h1a by auto have h3: "?f5orf6orf7 ⟶ (?f5 ∨ ?f6 ∨ ?f7)" by auto then have h1c: "?e2 ⟶ (?f1 ∨ ?f2 ∨ ?f3 ∨ ?f4 ∨ ?f5 ∨ ?f6 ∨ ?f7 ∨ ?f8orf9 ∨ ?f10orf11orf12) " using h1b by smt have h4: "?f8orf9 ⟶ (?f8 ∨ ?f9 ∨ ?f13)" by auto then have h1d: "?e2 ⟶ (?f1 ∨ ?f2 ∨ ?f3 ∨ ?f4 ∨ ?f5 ∨ ?f6 ∨ ?f7 ∨ ?f8 ∨ ?f9 ∨ ?f13 ∨ ?f10orf11orf12) " using h1c by smt have h5: "?f10orf11orf12 ⟶ (?f10 ∨ ?f11 ∨ ?f12)" by auto then have bigor: "?e2 ⟶ (?f1 ∨ ?f2 ∨ ?f3 ∨ ?f4 ∨ ?f5 ∨ ?f6 ∨ ?f7 ∨ ?f8 ∨ ?f13 ∨ ?f9 ∨ ?f10 ∨ ?f11 ∨ ?f12) " using h1d by smt have "?f1 ⟹ ?e1" proof - assume asm: "(∀(a, b, c)∈set a. a = 0 ∧ b = 0 ∧ c = 0) ∧ (∀(a, b, c)∈set b. ∃x. ∀y<x. a * y⇧2 + b * y + c < 0) ∧ (∀(a, b, c)∈set c. ∃x. ∀y<x. a * y⇧2 + b * y + c ≤ 0) ∧ (∀(a, b, c)∈set d. ∃x. ∀y<x. a * y⇧2 + b * y + c ≠ 0)" then have eqprop: "∀x. ∀(a, b, c)∈set a. a * x⇧2 + b * x + c = 0" by auto have "∃y. ∀x<y. ∀(a, b, c)∈set b. a * x⇧2 + b * x + c < 0" using asm h1b_helper_les by auto then obtain y1 where y1_prop: "∀x<y1. ∀(a, b, c)∈set b. a * x⇧2 + b * x + c < 0" by auto have "∃y. ∀x<y. ∀(a, b, c)∈set c. a * x⇧2 + b * x + c ≤ 0" using asm h1b_helper_leq by auto then obtain y2 where y2_prop: "∀x<y2. ∀(a, b, c)∈set c. a * x⇧2 + b * x + c ≤ 0" by auto have "∃y. ∀x<y. ∀(a, b, c)∈set d. a * x⇧2 + b * x + c ≠ 0" using asm h1b_helper_neq by auto then obtain y3 where y3_prop: "∀x<y3. ∀(a, b, c)∈set d. a * x⇧2 + b * x + c ≠ 0" by auto let ?y = "(min (min y1 y2) y3) - 1" have y_prop: "?y < y1 ∧ ?y < y2 ∧ ?y < y3" by auto have ap: "(∀(a, b, c)∈set a. a * ?y⇧2 + b * ?y + c = 0)" using eqprop by auto have bp: "(∀(a, b, c)∈set b. a * ?y⇧2 + b * ?y + c < 0)" using y_prop y1_prop by auto have cp: "(∀(a, b, c)∈set c. a * ?y⇧2 + b * ?y + c ≤ 0)" using y_prop y2_prop by auto have dp: "(∀(a, b, c)∈set d. a * ?y⇧2 + b * ?y + c ≠ 0)" using y_prop y3_prop by auto then have "(∀(a, b, c)∈set a. a * ?y⇧2 + b * ?y + c = 0) ∧ (∀(a, b, c)∈set b. a * ?y⇧2 + b * ?y + c < 0) ∧ (∀(a, b, c)∈set c. a * ?y⇧2 + b * ?y + c ≤ 0) ∧ (∀(a, b, c)∈set d. a * ?y⇧2 + b * ?y + c ≠ 0)" using ap bp cp dp by auto then show ?thesis by auto qed then have h1: "?f1 ⟶ ?e1" by auto have "?f2 ⟹ ?e1" proof - assume " ∃(a', b', c')∈set a. (a' = 0 ∧ b' ≠ 0) ∧ (∀(d, e, f)∈set a. d * (- c' / b')⇧2 + e * (- c' / b') + f = 0) ∧ (∀(d, e, f)∈set b. d * (- c' / b')⇧2 + e * (- c' / b') + f < 0) ∧ (∀(d, e, f)∈set c. d * (- c' / b')⇧2 + e * (- c' / b') + f ≤ 0) ∧ (∀(d, e, f)∈set d. d * (- c' / b')⇧2 + e * (- c' / b') + f ≠ 0)" then obtain a' b' c' where abc_prop: "(a', b', c')∈set a ∧ (a' = 0 ∧ b' ≠ 0) ∧ (∀(d, e, f)∈set a. d * (- c' / b')⇧2 + e * (- c' / b') + f = 0) ∧ (∀(d, e, f)∈set b. d * (- c' / b')⇧2 + e * (- c' / b') + f < 0) ∧ (∀(d, e, f)∈set c. d * (- c' / b')⇧2 + e * (- c' / b') + f ≤ 0) ∧ (∀(d, e, f)∈set d. d * (- c' / b')⇧2 + e * (- c' / b') + f ≠ 0)" by auto then have "∃(x::real). x = -c'/b'" by auto then obtain x where x_prop: "x = - c' / b'" by auto then have "(∀xa∈set a. case xa of (a, b, c) ⇒ a * x⇧2 + b * x + c = 0) ∧ (∀xa∈set b. case xa of (a, b, c) ⇒ a * x⇧2 + b * x + c < 0) ∧ (∀xa∈set c. case xa of (a, b, c) ⇒ a * x⇧2 + b * x + c ≤ 0) ∧ (∀xa∈set d. case xa of (a, b, c) ⇒ a * x⇧2 + b * x + c ≠ 0)" using abc_prop by auto then show ?thesis by auto qed then have h2: "?f2 ⟶ ?e1" by auto have "?f3 ⟹ ?e1" proof - assume "∃(a', b', c')∈set a. a' ≠ 0 ∧ - b'⇧2 + 4 * a' * c' ≤ 0 ∧ (∀(d, e, f)∈set a. d * ((- b' + 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a'))⇧2 + e * ((- b' + 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a')) + f = 0) ∧ (∀(d, e, f)∈set b. d * ((- b' + 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a'))⇧2 + e * ((- b' + 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a')) + f < 0) ∧ (∀(d, e, f)∈set c. d * ((- b' + 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a'))⇧2 + e * ((- b' + 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a')) + f ≤ 0) ∧ (∀(d, e, f)∈set d. d * ((- b' + 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a'))⇧2 + e * ((- b' + 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a')) + f ≠ 0)" then obtain a' b' c' where abc_prop: "(a', b', c')∈set a ∧ a' ≠ 0 ∧ - b'⇧2 + 4 * a' * c' ≤ 0 ∧ (∀(d, e, f)∈set a. d * ((- b' + 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a'))⇧2 + e * ((- b' + 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a')) + f = 0) ∧ (∀(d, e, f)∈set b. d * ((- b' + 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a'))⇧2 + e * ((- b' + 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a')) + f < 0) ∧ (∀(d, e, f)∈set c. d * ((- b' + 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a'))⇧2 + e * ((- b' + 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a')) + f ≤ 0) ∧ (∀(d, e, f)∈set d. d * ((- b' + 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a'))⇧2 + e * ((- b' + 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a')) + f ≠ 0)" by auto then have "∃(x::real). x = (- b' + 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a')" by auto then obtain x where x_prop: " x = (- b' + 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a')" by auto then have "(∀(a, b, c)∈set a. a * x⇧2 + b * x + c = 0) ∧ (∀(a, b, c)∈set b. a * x⇧2 + b * x + c < 0) ∧ (∀(a, b, c)∈set c. a * x⇧2 + b * x + c ≤ 0) ∧ (∀(a, b, c)∈set d. a * x⇧2 + b * x + c ≠ 0)" using abc_prop by auto then show ?thesis by auto qed then have h3: "?f3 ⟶ ?e1" by auto have "?f4 ⟹ ?e1" proof - assume " ∃(a', b', c')∈set a. a' ≠ 0 ∧ - b'⇧2 + 4 * a' * c' ≤ 0 ∧ (∀(d, e, f)∈set a. d * ((- b' + - 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a'))⇧2 + e * ((- b' + - 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a')) + f = 0) ∧ (∀(d, e, f)∈set b. d * ((- b' + - 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a'))⇧2 + e * ((- b' + - 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a')) + f < 0) ∧ (∀(d, e, f)∈set c. d * ((- b' + - 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a'))⇧2 + e * ((- b' + - 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a')) + f ≤ 0) ∧ (∀(d, e, f)∈set d. d * ((- b' + - 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a'))⇧2 + e * ((- b' + - 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a')) + f ≠ 0)" then obtain a' b' c' where abc_prop: "(a', b', c')∈set a ∧ a' ≠ 0 ∧ - b'⇧2 + 4 * a' * c' ≤ 0 ∧ (∀(d, e, f)∈set a. d * ((- b' + - 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a'))⇧2 + e * ((- b' + - 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a')) + f = 0) ∧ (∀(d, e, f)∈set b. d * ((- b' + - 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a'))⇧2 + e * ((- b' + - 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a')) + f < 0) ∧ (∀(d, e, f)∈set c. d * ((- b' + - 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a'))⇧2 + e * ((- b' + - 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a')) + f ≤ 0) ∧ (∀(d, e, f)∈set d. d * ((- b' + - 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a'))⇧2 + e * ((- b' + - 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a')) + f ≠ 0)" by auto then have "∃(x::real). x = (- b' + - 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a')" by auto then obtain x where x_prop: " x = (- b' + - 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a')" by auto then have "(∀(a, b, c)∈set a. a * x⇧2 + b * x + c = 0) ∧ (∀(a, b, c)∈set b. a * x⇧2 + b * x + c < 0) ∧ (∀(a, b, c)∈set c. a * x⇧2 + b * x + c ≤ 0) ∧ (∀(a, b, c)∈set d. a * x⇧2 + b * x + c ≠ 0)" using abc_prop by auto then show ?thesis by auto qed then have "?f4 ⟶ ?e1" by auto have "?f5 ⟹ ?e1" proof - assume asm: "∃(a', b', c')∈set b. (a' = 0 ∧ b' ≠ 0) ∧ (∀(d, e, f)∈set a. ∃y'>- c' / b'. ∀x∈{- c' / b'<..y'}. d * x⇧2 + e * x + f = 0) ∧ (∀(d, e, f)∈set b. ∃y'>- c' / b'. ∀x∈{- c' / b'<..y'}. d * x⇧2 + e * x + f < 0) ∧ (∀(d, e, f)∈set c. ∃y'>- c' / b'. ∀x∈{- c' / b'<..y'}. d * x⇧2 + e * x + f ≤ 0) ∧ (∀(d, e, f)∈set d. ∃y'>- c' / b'. ∀x∈{- c' / b'<..y'}. d * x⇧2 + e * x + f ≠ 0)" then obtain a' b' c' where abc_prop: "(a', b', c')∈set b ∧ (a' = 0 ∧ b' ≠ 0) ∧ (∀(d, e, f)∈set a. ∃y'>- c' / b'. ∀x∈{- c' / b'<..y'}. d * x⇧2 + e * x + f = 0) ∧ (∀(d, e, f)∈set b. ∃y'>- c' / b'. ∀x∈{- c' / b'<..y'}. d * x⇧2 + e * x + f < 0) ∧ (∀(d, e, f)∈set c. ∃y'>- c' / b'. ∀x∈{- c' / b'<..y'}. d * x⇧2 + e * x + f ≤ 0) ∧ (∀(d, e, f)∈set d. ∃y'>- c' / b'. ∀x∈{- c' / b'<..y'}. d * x⇧2 + e * x + f ≠ 0)" by auto then show ?thesis using qe_infinitesimals_helper[of a "- c' / b'" b c d] by auto qed then have h5: "?f5 ⟶ ?e1" by auto have "?f6 ⟹ ?e1" proof - assume "∃(a', b', c')∈set b. a' ≠ 0 ∧ - b'⇧2 + 4 * a' * c' ≤ 0 ∧ (∀(d, e, f)∈set a. ∃y'>(- b' + 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a'). ∀x∈{(- b' + 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a')<..y'}. d * x⇧2 + e * x + f = 0) ∧ (∀(d, e, f)∈set b. ∃y'>(- b' + 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a'). ∀x∈{(- b' + 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a')<..y'}. d * x⇧2 + e * x + f < 0) ∧ (∀(d, e, f)∈set c. ∃y'>(- b' + 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a'). ∀x∈{(- b' + 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a')<..y'}. d * x⇧2 + e * x + f ≤ 0) ∧ (∀(d, e, f)∈set d. ∃y'>(- b' + 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a'). ∀x∈{(- b' + 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a')<..y'}. d * x⇧2 + e * x + f ≠ 0)" then obtain a' b' c' where abc_prop: "(a', b', c')∈set b ∧ a' ≠ 0 ∧ - b'⇧2 + 4 * a' * c' ≤ 0 ∧ (∀(d, e, f)∈set a. ∃y'>(- b' + 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a'). ∀x∈{(- b' + 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a')<..y'}. d * x⇧2 + e * x + f = 0) ∧ (∀(d, e, f)∈set b. ∃y'>(- b' + 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a'). ∀x∈{(- b' + 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a')<..y'}. d * x⇧2 + e * x + f < 0) ∧ (∀(d, e, f)∈set c. ∃y'>(- b' + 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a'). ∀x∈{(- b' + 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a')<..y'}. d * x⇧2 + e * x + f ≤ 0) ∧ (∀(d, e, f)∈set d. ∃y'>(- b' + 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a'). ∀x∈{(- b' + 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a')<..y'}. d * x⇧2 + e * x + f ≠ 0)" by auto then show ?thesis using qe_infinitesimals_helper[of a "(- b' + 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a')" b c d] by auto qed then have h6: "?f6 ⟶ ?e1" by auto have "?f7 ⟹ ?e1" proof - assume "∃(a', b', c')∈set b. a' ≠ 0 ∧ - b'⇧2 + 4 * a' * c' ≤ 0 ∧ (∀(d, e, f)∈set a. ∃y'>(- b' + - 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a'). ∀x∈{(- b' + - 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a')<..y'}. d * x⇧2 + e * x + f = 0) ∧ (∀(d, e, f)∈set b. ∃y'>(- b' + - 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a'). ∀x∈{(- b' + - 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a')<..y'}. d * x⇧2 + e * x + f < 0) ∧ (∀(d, e, f)∈set c. ∃y'>(- b' + - 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a'). ∀x∈{(- b' + - 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a')<..y'}. d * x⇧2 + e * x + f ≤ 0) ∧ (∀(d, e, f)∈set d. ∃y'>(- b' + - 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a'). ∀x∈{(- b' + - 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a')<..y'}. d * x⇧2 + e * x + f ≠ 0)" then obtain a' b' c' where abc_prop: "(a', b', c')∈set b ∧ a' ≠ 0 ∧ - b'⇧2 + 4 * a' * c' ≤ 0 ∧ (∀(d, e, f)∈set a. ∃y'>(- b' + - 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a'). ∀x∈{(- b' + - 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a')<..y'}. d * x⇧2 + e * x + f = 0) ∧ (∀(d, e, f)∈set b. ∃y'>(- b' + - 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a'). ∀x∈{(- b' + - 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a')<..y'}. d * x⇧2 + e * x + f < 0) ∧ (∀(d, e, f)∈set c. ∃y'>(- b' + - 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a'). ∀x∈{(- b' + - 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a')<..y'}. d * x⇧2 + e * x + f ≤ 0) ∧ (∀(d, e, f)∈set d. ∃y'>(- b' + - 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a'). ∀x∈{(- b' + - 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a')<..y'}. d * x⇧2 + e * x + f ≠ 0)" by auto then show ?thesis using qe_infinitesimals_helper[of a "(- b' + - 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a')" b c d] by auto qed then have h7: "?f7 ⟶ ?e1" by auto have "?f8 ⟹ ?e1" proof - assume "∃(a', b', c')∈set c. (a' = 0 ∧ b' ≠ 0) ∧ (∀(d, e, f)∈set a. d * (- c' / b')⇧2 + e * (- c' / b') + f = 0) ∧ (∀(d, e, f)∈set b. d * (- c' / b')⇧2 + e * (- c' / b') + f < 0) ∧ (∀(d, e, f)∈set c. d * (- c' / b')⇧2 + e * (- c' / b') + f ≤ 0) ∧ (∀(d, e, f)∈set d. d * (- c' / b')⇧2 + e * (- c' / b') + f ≠ 0)" then obtain a' b' c' where abc_prop: "(a', b', c')∈set c ∧ (a' = 0 ∧ b' ≠ 0) ∧ (∀(d, e, f)∈set a. d * (- c' / b')⇧2 + e * (- c' / b') + f = 0) ∧ (∀(d, e, f)∈set b. d * (- c' / b')⇧2 + e * (- c' / b') + f < 0) ∧ (∀(d, e, f)∈set c. d * (- c' / b')⇧2 + e * (- c' / b') + f ≤ 0) ∧ (∀(d, e, f)∈set d. d * (- c' / b')⇧2 + e * (- c' / b') + f ≠ 0)" by auto then have "∃(x::real). x = (- c' / b')" by auto then obtain x where x_prop: " x = - c' / b'" by auto then have "(∀(a, b, c)∈set a. a * x⇧2 + b * x + c = 0) ∧ (∀(a, b, c)∈set b. a * x⇧2 + b * x + c < 0) ∧ (∀(a, b, c)∈set c. a * x⇧2 + b * x + c ≤ 0) ∧ (∀(a, b, c)∈set d. a * x⇧2 + b * x + c ≠ 0)" using abc_prop by auto then show ?thesis by auto qed then have h8: "?f8 ⟶ ?e1" by auto have "?f9 ⟹ ?e1" proof - assume "∃(a', b', c')∈set c. a' ≠ 0 ∧ - b'⇧2 + 4 * a' * c' ≤ 0 ∧ (∀(d, e, f)∈set a. d * ((- b' + - 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a'))⇧2 + e * ((- b' + - 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a')) + f = 0) ∧ (∀(d, e, f)∈set b. d * ((- b' + - 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a'))⇧2 + e * ((- b' + - 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a')) + f < 0) ∧ (∀(d, e, f)∈set c. d * ((- b' + - 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a'))⇧2 + e * ((- b' + - 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a')) + f ≤ 0) ∧ (∀(d, e, f)∈set d. d * ((- b' + - 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a'))⇧2 + e * ((- b' + - 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a')) + f ≠ 0)" then obtain a' b' c' where abc_prop: "(a', b', c')∈set c ∧ a' ≠ 0 ∧ - b'⇧2 + 4 * a' * c' ≤ 0 ∧ (∀(d, e, f)∈set a. d * ((- b' + - 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a'))⇧2 + e * ((- b' + - 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a')) + f = 0) ∧ (∀(d, e, f)∈set b. d * ((- b' + - 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a'))⇧2 + e * ((- b' + - 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a')) + f < 0) ∧ (∀(d, e, f)∈set c. d * ((- b' + - 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a'))⇧2 + e * ((- b' + - 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a')) + f ≤ 0) ∧ (∀(d, e, f)∈set d. d * ((- b' + - 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a'))⇧2 + e * ((- b' + - 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a')) + f ≠ 0)" by auto then have "∃(x::real). x = (- b' + - 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a')" by auto then obtain x where x_prop: " x = (- b' + - 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a')" by auto then have "(∀(a, b, c)∈set a. a * x⇧2 + b * x + c = 0) ∧ (∀(a, b, c)∈set b. a * x⇧2 + b * x + c < 0) ∧ (∀(a, b, c)∈set c. a * x⇧2 + b * x + c ≤ 0) ∧ (∀(a, b, c)∈set d. a * x⇧2 + b * x + c ≠ 0)" using abc_prop by auto then show ?thesis by auto qed then have h9: "?f9 ⟶ ?e1" by auto have "?f10 ⟹ ?e1" proof - assume asm: "∃(a', b', c')∈set d. (a' = 0 ∧ b' ≠ 0) ∧ (∀(d, e, f)∈set a. ∃y'>- c' / b'. ∀x∈{- c' / b'<..y'}. d * x⇧2 + e * x + f = 0) ∧ (∀(d, e, f)∈set b. ∃y'>- c' / b'. ∀x∈{- c' / b'<..y'}. d * x⇧2 + e * x + f < 0) ∧ (∀(d, e, f)∈set c. ∃y'>- c' / b'. ∀x∈{- c' / b'<..y'}. d * x⇧2 + e * x + f ≤ 0) ∧ (∀(d, e, f)∈set d. ∃y'>- c' / b'. ∀x∈{- c' / b'<..y'}. d * x⇧2 + e * x + f ≠ 0)" then obtain a' b' c' where abc_prop: "(a', b', c')∈set d ∧ (a' = 0 ∧ b' ≠ 0) ∧ (∀(d, e, f)∈set a. ∃y'>- c' / b'. ∀x∈{- c' / b'<..y'}. d * x⇧2 + e * x + f = 0) ∧ (∀(d, e, f)∈set b. ∃y'>- c' / b'. ∀x∈{- c' / b'<..y'}. d * x⇧2 + e * x + f < 0) ∧ (∀(d, e, f)∈set c. ∃y'>- c' / b'. ∀x∈{- c' / b'<..y'}. d * x⇧2 + e * x + f ≤ 0) ∧ (∀(d, e, f)∈set d. ∃y'>- c' / b'. ∀x∈{- c' / b'<..y'}. d * x⇧2 + e * x + f ≠ 0)" by auto then show ?thesis using qe_infinitesimals_helper[of a "- c' / b'" b c d] by auto qed then have h10: "?f10 ⟶ ?e1" by auto have "?f11 ⟹ ?e1" proof - assume "∃(a', b', c')∈set d. a' ≠ 0 ∧ - b'⇧2 + 4 * a' * c' ≤ 0 ∧ (∀(d, e, f)∈set a. ∃y'>(- b' + 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a'). ∀x∈{(- b' + 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a')<..y'}. d * x⇧2 + e * x + f = 0) ∧ (∀(d, e, f)∈set b. ∃y'>(- b' + 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a'). ∀x∈{(- b' + 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a')<..y'}. d * x⇧2 + e * x + f < 0) ∧ (∀(d, e, f)∈set c. ∃y'>(- b' + 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a'). ∀x∈{(- b' + 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a')<..y'}. d * x⇧2 + e * x + f ≤ 0) ∧ (∀(d, e, f)∈set d. ∃y'>(- b' + 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a'). ∀x∈{(- b' + 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a')<..y'}. d * x⇧2 + e * x + f ≠ 0)" then obtain a' b' c' where abc_prop: "(a', b', c')∈set d ∧ a' ≠ 0 ∧ - b'⇧2 + 4 * a' * c' ≤ 0 ∧ (∀(d, e, f)∈set a. ∃y'>(- b' + 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a'). ∀x∈{(- b' + 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a')<..y'}. d * x⇧2 + e * x + f = 0) ∧ (∀(d, e, f)∈set b. ∃y'>(- b' + 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a'). ∀x∈{(- b' + 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a')<..y'}. d * x⇧2 + e * x + f < 0) ∧ (∀(d, e, f)∈set c. ∃y'>(- b' + 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a'). ∀x∈{(- b' + 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a')<..y'}. d * x⇧2 + e * x + f ≤ 0) ∧ (∀(d, e, f)∈set d. ∃y'>(- b' + 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a'). ∀x∈{(- b' + 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a')<..y'}. d * x⇧2 + e * x + f ≠ 0)" by auto then show ?thesis using qe_infinitesimals_helper[of a "(- b' + 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a')" b c d] by auto qed then have h11: "?f11 ⟶ ?e1" by auto have "?f12 ⟹ ?e1" proof - assume "∃(a', b', c')∈set d. a' ≠ 0 ∧ - b'⇧2 + 4 * a' * c' ≤ 0 ∧ (∀(d, e, f)∈set a. ∃y'>(- b' + - 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a'). ∀x∈{(- b' + - 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a')<..y'}. d * x⇧2 + e * x + f = 0) ∧ (∀(d, e, f)∈set b. ∃y'>(- b' + - 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a'). ∀x∈{(- b' + - 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a')<..y'}. d * x⇧2 + e * x + f < 0) ∧ (∀(d, e, f)∈set c. ∃y'>(- b' + - 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a'). ∀x∈{(- b' + - 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a')<..y'}. d * x⇧2 + e * x + f ≤ 0) ∧ (∀(d, e, f)∈set d. ∃y'>(- b' + - 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a'). ∀x∈{(- b' + - 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a')<..y'}. d * x⇧2 + e * x + f ≠ 0)" then obtain a' b' c' where abc_prop: "(a', b', c')∈set d ∧ a' ≠ 0 ∧ - b'⇧2 + 4 * a' * c' ≤ 0 ∧ (∀(d, e, f)∈set a. ∃y'>(- b' + - 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a'). ∀x∈{(- b' + - 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a')<..y'}. d * x⇧2 + e * x + f = 0) ∧ (∀(d, e, f)∈set b. ∃y'>(- b' + - 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a'). ∀x∈{(- b' + - 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a')<..y'}. d * x⇧2 + e * x + f < 0) ∧ (∀(d, e, f)∈set c. ∃y'>(- b' + - 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a'). ∀x∈{(- b' + - 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a')<..y'}. d * x⇧2 + e * x + f ≤ 0) ∧ (∀(d, e, f)∈set d. ∃y'>(- b' + - 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a'). ∀x∈{(- b' + - 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a')<..y'}. d * x⇧2 + e * x + f ≠ 0)" by auto then show ?thesis using qe_infinitesimals_helper[of a "(- b' + - 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a')" b c d] by auto qed then have h12: "?f12 ⟶ ?e1" by auto have "?f13 ⟹ ?e1" proof - assume " ∃(a', b', c')∈set c. a' ≠ 0 ∧ - b'⇧2 + 4 * a' * c' ≤ 0 ∧ (∀(d, e, f)∈set a. d * ((- b' + 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a'))⇧2 + e * ((- b' + 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a')) + f = 0) ∧ (∀(d, e, f)∈set b. d * ((- b' + 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a'))⇧2 + e * ((- b' + 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a')) + f < 0) ∧ (∀(d, e, f)∈set c. d * ((- b' + 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a'))⇧2 + e * ((- b' + 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a')) + f ≤ 0) ∧ (∀(d, e, f)∈set d. d * ((- b' + 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a'))⇧2 + e * ((- b' + 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a')) + f ≠ 0)" then obtain a' b' c' where abc_prop: "(a', b', c')∈set c ∧ a' ≠ 0 ∧ - b'⇧2 + 4 * a' * c' ≤ 0 ∧ (∀(d, e, f)∈set a. d * ((- b' + 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a'))⇧2 + e * ((- b' + 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a')) + f = 0) ∧ (∀(d, e, f)∈set b. d * ((- b' + 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a'))⇧2 + e * ((- b' + 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a')) + f < 0) ∧ (∀(d, e, f)∈set c. d * ((- b' + 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a'))⇧2 + e * ((- b' + 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a')) + f ≤ 0) ∧ (∀(d, e, f)∈set d. d * ((- b' + 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a'))⇧2 + e * ((- b' + 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a')) + f ≠ 0)" by auto then have "∃(x::real). x = (- b' + 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a')" by auto then obtain x where x_prop: " x = (- b' + 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a')" by auto then have "(∀(a, b, c)∈set a. a * x⇧2 + b * x + c = 0) ∧ (∀(a, b, c)∈set b. a * x⇧2 + b * x + c < 0) ∧ (∀(a, b, c)∈set c. a * x⇧2 + b * x + c ≤ 0) ∧ (∀(a, b, c)∈set d. a * x⇧2 + b * x + c ≠ 0)" using abc_prop by auto then show ?thesis by auto qed then have h13: "?f13 ⟶ ?e1" by auto show ?thesis using bigor h1 h2 h3 h4 h5 h6 h7 h8 h9 h10 h11 h12 h13 using assms by (smt ‹∃(a', b', c')∈set a. a' ≠ 0 ∧ - b'⇧2 + 4 * a' * c' ≤ 0 ∧ (∀(d, e, f)∈set a. d * ((- b' + - 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a'))⇧2 + e * ((- b' + - 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a')) + f = 0) ∧ (∀(d, e, f)∈set b. d * ((- b' + - 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a'))⇧2 + e * ((- b' + - 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a')) + f < 0) ∧ (∀(d, e, f)∈set c. d * ((- b' + - 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a'))⇧2 + e * ((- b' + - 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a')) + f ≤ 0) ∧ (∀(d, e, f)∈set d. d * ((- b' + - 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a'))⇧2 + e * ((- b' + - 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a')) + f ≠ 0) ⟹ ∃x. (∀(a, b, c)∈set a. a * x⇧2 + b * x + c = 0) ∧ (∀(a, b, c)∈set b. a * x⇧2 + b * x + c < 0) ∧ (∀(a, b, c)∈set c. a * x⇧2 + b * x + c ≤ 0) ∧ (∀(a, b, c)∈set d. a * x⇧2 + b * x + c ≠ 0)›) (* by force *) qed subsection "General QE lemmas" lemma qe: "(∃x. (∀(a, b, c)∈set a. a * x⇧2 + b * x + c = 0) ∧ (∀(a, b, c)∈set b. a * x⇧2 + b * x + c < 0) ∧ (∀(a, b, c)∈set c. a * x⇧2 + b * x + c ≤ 0) ∧ (∀(a, b, c)∈set d. a * x⇧2 + b * x + c ≠ 0)) = ((∀(a, b, c)∈set a. a = 0 ∧ b = 0 ∧ c = 0) ∧ (∀(a, b, c)∈set b. ∃x. ∀y<x. a * y⇧2 + b * y + c < 0) ∧ (∀(a, b, c)∈set c. ∃x. ∀y<x. a * y⇧2 + b * y + c ≤ 0) ∧ (∀(a, b, c)∈set d. ∃x. ∀y<x. a * y⇧2 + b * y + c ≠ 0) ∨ (∃(a', b', c')∈set a. (a' = 0 ∧ b' ≠ 0) ∧ (∀(d, e, f)∈set a. d * (- c' / b')⇧2 + e * (- c' / b') + f = 0) ∧ (∀(d, e, f)∈set b. d * (- c' / b')⇧2 + e * (- c' / b') + f < 0) ∧ (∀(d, e, f)∈set c. d * (- c' / b')⇧2 + e * (- c' / b') + f ≤ 0) ∧ (∀(d, e, f)∈set d. d * (- c' / b')⇧2 + e * (- c' / b') + f ≠ 0) ∨ a' ≠ 0 ∧ - b'⇧2 + 4 * a' * c' ≤ 0 ∧ ((∀(d, e, f)∈set a. d * ((- b' + 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a'))⇧2 + e * ((- b' + 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a')) + f = 0) ∧ (∀(d, e, f)∈set b. d * ((- b' + 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a'))⇧2 + e * ((- b' + 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a')) + f < 0) ∧ (∀(d, e, f)∈set c. d * ((- b' + 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a'))⇧2 + e * ((- b' + 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a')) + f ≤ 0) ∧ (∀(d, e, f)∈set d. d * ((- b' + 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a'))⇧2 + e * ((- b' + 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a')) + f ≠ 0) ∨ (∀(d, e, f)∈set a. d * ((- b' + - 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a'))⇧2 + e * ((- b' + - 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a')) + f = 0) ∧ (∀(d, e, f)∈set b. d * ((- b' + - 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a'))⇧2 + e * ((- b' + - 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a')) + f < 0) ∧ (∀(d, e, f)∈set c. d * ((- b' + - 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a'))⇧2 + e * ((- b' + - 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a')) + f ≤ 0) ∧ (∀(d, e, f)∈set d. d * ((- b' + - 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a'))⇧2 + e * ((- b' + - 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a')) + f ≠ 0))) ∨ (∃(a', b', c')∈set b. (a' = 0 ∧ b' ≠ 0) ∧ (∀(d, e, f)∈set a. ∃y'>- c' / b'. ∀x∈{- c' / b'<..y'}. d * x⇧2 + e * x + f = 0) ∧ (∀(d, e, f)∈set b. ∃y'>- c' / b'. ∀x∈{- c' / b'<..y'}. d * x⇧2 + e * x + f < 0) ∧ (∀(d, e, f)∈set c. ∃y'>- c' / b'. ∀x∈{- c' / b'<..y'}. d * x⇧2 + e * x + f ≤ 0) ∧ (∀(d, e, f)∈set d. ∃y'>- c' / b'. ∀x∈{- c' / b'<..y'}. d * x⇧2 + e * x + f ≠ 0) ∨ a' ≠ 0 ∧ - b'⇧2 + 4 * a' * c' ≤ 0 ∧ ((∀(d, e, f)∈set a. ∃y'>(- b' + 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a'). ∀x∈{(- b' + 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a')<..y'}. d * x⇧2 + e * x + f = 0) ∧ (∀(d, e, f)∈set b. ∃y'>(- b' + 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a'). ∀x∈{(- b' + 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a')<..y'}. d * x⇧2 + e * x + f < 0) ∧ (∀(d, e, f)∈set c. ∃y'>(- b' + 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a'). ∀x∈{(- b' + 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a')<..y'}. d * x⇧2 + e * x + f ≤ 0) ∧ (∀(d, e, f)∈set d. ∃y'>(- b' + 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a'). ∀x∈{(- b' + 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a')<..y'}. d * x⇧2 + e * x + f ≠ 0) ∨ (∀(d, e, f)∈set a. ∃y'>(- b' + - 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a'). ∀x∈{(- b' + - 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a')<..y'}. d * x⇧2 + e * x + f = 0) ∧ (∀(d, e, f)∈set b. ∃y'>(- b' + - 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a'). ∀x∈{(- b' + - 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a')<..y'}. d * x⇧2 + e * x + f < 0) ∧ (∀(d, e, f)∈set c. ∃y'>(- b' + - 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a'). ∀x∈{(- b' + - 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a')<..y'}. d * x⇧2 + e * x + f ≤ 0) ∧ (∀(d, e, f)∈set d. ∃y'>(- b' + - 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a'). ∀x∈{(- b' + - 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a')<..y'}. d * x⇧2 + e * x + f ≠ 0))) ∨ (∃(a', b', c')∈set c. (a' = 0 ∧ b' ≠ 0) ∧ (∀(d, e, f)∈set a. d * (- c' / b')⇧2 + e * (- c' / b') + f = 0) ∧ (∀(d, e, f)∈set b. d * (- c' / b')⇧2 + e * (- c' / b') + f < 0) ∧ (∀(d, e, f)∈set c. d * (- c' / b')⇧2 + e * (- c' / b') + f ≤ 0) ∧ (∀(d, e, f)∈set d. d * (- c' / b')⇧2 + e * (- c' / b') + f ≠ 0) ∨ a' ≠ 0 ∧ - b'⇧2 + 4 * a' * c' ≤ 0 ∧ ((∀(d, e, f)∈set a. d * ((- b' + 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a'))⇧2 + e * ((- b' + 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a')) + f = 0) ∧ (∀(d, e, f)∈set b. d * ((- b' + 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a'))⇧2 + e * ((- b' + 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a')) + f < 0) ∧ (∀(d, e, f)∈set c. d * ((- b' + 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a'))⇧2 + e * ((- b' + 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a')) + f ≤ 0) ∧ (∀(d, e, f)∈set d. d * ((- b' + 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a'))⇧2 + e * ((- b' + 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a')) + f ≠ 0) ∨ (∀(d, e, f)∈set a. d * ((- b' + - 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a'))⇧2 + e * ((- b' + - 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a')) + f = 0) ∧ (∀(d, e, f)∈set b. d * ((- b' + - 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a'))⇧2 + e * ((- b' + - 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a')) + f < 0) ∧ (∀(d, e, f)∈set c. d * ((- b' + - 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a'))⇧2 + e * ((- b' + - 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a')) + f ≤ 0) ∧ (∀(d, e, f)∈set d. d * ((- b' + - 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a'))⇧2 + e * ((- b' + - 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a')) + f ≠ 0))) ∨ (∃(a', b', c')∈set d. (a' = 0 ∧ b' ≠ 0) ∧ (∀(d, e, f)∈set a. ∃y'>- c' / b'. ∀x∈{- c' / b'<..y'}. d * x⇧2 + e * x + f = 0) ∧ (∀(d, e, f)∈set b. ∃y'>- c' / b'. ∀x∈{- c' / b'<..y'}. d * x⇧2 + e * x + f < 0) ∧ (∀(d, e, f)∈set c. ∃y'>- c' / b'. ∀x∈{- c' / b'<..y'}. d * x⇧2 + e * x + f ≤ 0) ∧ (∀(d, e, f)∈set d. ∃y'>- c' / b'. ∀x∈{- c' / b'<..y'}. d * x⇧2 + e * x + f ≠ 0) ∨ a' ≠ 0 ∧ - b'⇧2 + 4 * a' * c' ≤ 0 ∧ ((∀(d, e, f)∈set a. ∃y'>(- b' + 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a'). ∀x∈{(- b' + 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a')<..y'}. d * x⇧2 + e * x + f = 0) ∧ (∀(d, e, f)∈set b. ∃y'>(- b' + 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a'). ∀x∈{(- b' + 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a')<..y'}. d * x⇧2 + e * x + f < 0) ∧ (∀(d, e, f)∈set c. ∃y'>(- b' + 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a'). ∀x∈{(- b' + 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a')<..y'}. d * x⇧2 + e * x + f ≤ 0) ∧ (∀(d, e, f)∈set d. ∃y'>(- b' + 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a'). ∀x∈{(- b' + 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a')<..y'}. d * x⇧2 + e * x + f ≠ 0) ∨ (∀(d, e, f)∈set a. ∃y'>(- b' + - 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a'). ∀x∈{(- b' + - 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a')<..y'}. d * x⇧2 + e * x + f = 0) ∧ (∀(d, e, f)∈set b. ∃y'>(- b' + - 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a'). ∀x∈{(- b' + - 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a')<..y'}. d * x⇧2 + e * x + f < 0) ∧ (∀(d, e, f)∈set c. ∃y'>(- b' + - 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a'). ∀x∈{(- b' + - 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a')<..y'}. d * x⇧2 + e * x + f ≤ 0) ∧ (∀(d, e, f)∈set d. ∃y'>(- b' + - 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a'). ∀x∈{(- b' + - 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a')<..y'}. d * x⇧2 + e * x + f ≠ 0))))" proof - let ?e1 = "((∀(a, b, c)∈set a. a = 0 ∧ b = 0 ∧ c = 0) ∧ (∀(a, b, c)∈set b. ∃x. ∀y<x. a * y⇧2 + b * y + c < 0) ∧ (∀(a, b, c)∈set c. ∃x. ∀y<x. a * y⇧2 + b * y + c ≤ 0) ∧ (∀(a, b, c)∈set d. ∃x. ∀y<x. a * y⇧2 + b * y + c ≠ 0) ∨ (∃(a', b', c')∈set a. (a' = 0 ∧ b' ≠ 0) ∧ (∀(d, e, f)∈set a. d * (- c' / b')⇧2 + e * (- c' / b') + f = 0) ∧ (∀(d, e, f)∈set b. d * (- c' / b')⇧2 + e * (- c' / b') + f < 0) ∧ (∀(d, e, f)∈set c. d * (- c' / b')⇧2 + e * (- c' / b') + f ≤ 0) ∧ (∀(d, e, f)∈set d. d * (- c' / b')⇧2 + e * (- c' / b') + f ≠ 0) ∨ a' ≠ 0 ∧ - b'⇧2 + 4 * a' * c' ≤ 0 ∧ ((∀(d, e, f)∈set a. d * ((- b' + 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a'))⇧2 + e * ((- b' + 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a')) + f = 0) ∧ (∀(d, e, f)∈set b. d * ((- b' + 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a'))⇧2 + e * ((- b' + 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a')) + f < 0) ∧ (∀(d, e, f)∈set c. d * ((- b' + 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a'))⇧2 + e * ((- b' + 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a')) + f ≤ 0) ∧ (∀(d, e, f)∈set d. d * ((- b' + 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a'))⇧2 + e * ((- b' + 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a')) + f ≠ 0) ∨ (∀(d, e, f)∈set a. d * ((- b' + - 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a'))⇧2 + e * ((- b' + - 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a')) + f = 0) ∧ (∀(d, e, f)∈set b. d * ((- b' + - 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a'))⇧2 + e * ((- b' + - 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a')) + f < 0) ∧ (∀(d, e, f)∈set c. d * ((- b' + - 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a'))⇧2 + e * ((- b' + - 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a')) + f ≤ 0) ∧ (∀(d, e, f)∈set d. d * ((- b' + - 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a'))⇧2 + e * ((- b' + - 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a')) + f ≠ 0))) ∨ (∃(a', b', c')∈set b. (a' = 0 ∧ b' ≠ 0) ∧ (∀(d, e, f)∈set a. ∃y'>- c' / b'. ∀x∈{- c' / b'<..y'}. d * x⇧2 + e * x + f = 0) ∧ (∀(d, e, f)∈set b. ∃y'>- c' / b'. ∀x∈{- c' / b'<..y'}. d * x⇧2 + e * x + f < 0) ∧ (∀(d, e, f)∈set c. ∃y'>- c' / b'. ∀x∈{- c' / b'<..y'}. d * x⇧2 + e * x + f ≤ 0) ∧ (∀(d, e, f)∈set d. ∃y'>- c' / b'. ∀x∈{- c' / b'<..y'}. d * x⇧2 + e * x + f ≠ 0) ∨ a' ≠ 0 ∧ - b'⇧2 + 4 * a' * c' ≤ 0 ∧ ((∀(d, e, f)∈set a. ∃y'>(- b' + 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a'). ∀x∈{(- b' + 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a')<..y'}. d * x⇧2 + e * x + f = 0) ∧ (∀(d, e, f)∈set b. ∃y'>(- b' + 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a'). ∀x∈{(- b' + 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a')<..y'}. d * x⇧2 + e * x + f < 0) ∧ (∀(d, e, f)∈set c. ∃y'>(- b' + 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a'). ∀x∈{(- b' + 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a')<..y'}. d * x⇧2 + e * x + f ≤ 0) ∧ (∀(d, e, f)∈set d. ∃y'>(- b' + 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a'). ∀x∈{(- b' + 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a')<..y'}. d * x⇧2 + e * x + f ≠ 0) ∨ (∀(d, e, f)∈set a. ∃y'>(- b' + - 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a'). ∀x∈{(- b' + - 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a')<..y'}. d * x⇧2 + e * x + f = 0) ∧ (∀(d, e, f)∈set b. ∃y'>(- b' + - 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a'). ∀x∈{(- b' + - 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a')<..y'}. d * x⇧2 + e * x + f < 0) ∧ (∀(d, e, f)∈set c. ∃y'>(- b' + - 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a'). ∀x∈{(- b' + - 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a')<..y'}. d * x⇧2 + e * x + f ≤ 0) ∧ (∀(d, e, f)∈set d. ∃y'>(- b' + - 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a'). ∀x∈{(- b' + - 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a')<..y'}. d * x⇧2 + e * x + f ≠ 0))) ∨ (∃(a', b', c')∈set c. (a' = 0 ∧ b' ≠ 0) ∧ (∀(d, e, f)∈set a. d * (- c' / b')⇧2 + e * (- c' / b') + f = 0) ∧ (∀(d, e, f)∈set b. d * (- c' / b')⇧2 + e * (- c' / b') + f < 0) ∧ (∀(d, e, f)∈set c. d * (- c' / b')⇧2 + e * (- c' / b') + f ≤ 0) ∧ (∀(d, e, f)∈set d. d * (- c' / b')⇧2 + e * (- c' / b') + f ≠ 0) ∨ a' ≠ 0 ∧ - b'⇧2 + 4 * a' * c' ≤ 0 ∧ ((∀(d, e, f)∈set a. d * ((- b' + 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a'))⇧2 + e * ((- b' + 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a')) + f = 0) ∧ (∀(d, e, f)∈set b. d * ((- b' + 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a'))⇧2 + e * ((- b' + 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a')) + f < 0) ∧ (∀(d, e, f)∈set c. d * ((- b' + 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a'))⇧2 + e * ((- b' + 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a')) + f ≤ 0) ∧ (∀(d, e, f)∈set d. d * ((- b' + 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a'))⇧2 + e * ((- b' + 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a')) + f ≠ 0) ∨ (∀(d, e, f)∈set a. d * ((- b' + - 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a'))⇧2 + e * ((- b' + - 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a')) + f = 0) ∧ (∀(d, e, f)∈set b. d * ((- b' + - 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a'))⇧2 + e * ((- b' + - 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a')) + f < 0) ∧ (∀(d, e, f)∈set c. d * ((- b' + - 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a'))⇧2 + e * ((- b' + - 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a')) + f ≤ 0) ∧ (∀(d, e, f)∈set d. d * ((- b' + - 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a'))⇧2 + e * ((- b' + - 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a')) + f ≠ 0))) ∨ (∃(a', b', c')∈set d. (a' = 0 ∧ b' ≠ 0) ∧ (∀(d, e, f)∈set a. ∃y'>- c' / b'. ∀x∈{- c' / b'<..y'}. d * x⇧2 + e * x + f = 0) ∧ (∀(d, e, f)∈set b. ∃y'>- c' / b'. ∀x∈{- c' / b'<..y'}. d * x⇧2 + e * x + f < 0) ∧ (∀(d, e, f)∈set c. ∃y'>- c' / b'. ∀x∈{- c' / b'<..y'}. d * x⇧2 + e * x + f ≤ 0) ∧ (∀(d, e, f)∈set d. ∃y'>- c' / b'. ∀x∈{- c' / b'<..y'}. d * x⇧2 + e * x + f ≠ 0) ∨ a' ≠ 0 ∧ - b'⇧2 + 4 * a' * c' ≤ 0 ∧ ((∀(d, e, f)∈set a. ∃y'>(- b' + 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a'). ∀x∈{(- b' + 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a')<..y'}. d * x⇧2 + e * x + f = 0) ∧ (∀(d, e, f)∈set b. ∃y'>(- b' + 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a'). ∀x∈{(- b' + 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a')<..y'}. d * x⇧2 + e * x + f < 0) ∧ (∀(d, e, f)∈set c. ∃y'>(- b' + 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a'). ∀x∈{(- b' + 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a')<..y'}. d * x⇧2 + e * x + f ≤ 0) ∧ (∀(d, e, f)∈set d. ∃y'>(- b' + 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a'). ∀x∈{(- b' + 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a')<..y'}. d * x⇧2 + e * x + f ≠ 0) ∨ (∀(d, e, f)∈set a. ∃y'>(- b' + - 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a'). ∀x∈{(- b' + - 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a')<..y'}. d * x⇧2 + e * x + f = 0) ∧ (∀(d, e, f)∈set b. ∃y'>(- b' + - 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a'). ∀x∈{(- b' + - 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a')<..y'}. d * x⇧2 + e * x + f < 0) ∧ (∀(d, e, f)∈set c. ∃y'>(- b' + - 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a'). ∀x∈{(- b' + - 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a')<..y'}. d * x⇧2 + e * x + f ≤ 0) ∧ (∀(d, e, f)∈set d. ∃y'>(- b' + - 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a'). ∀x∈{(- b' + - 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a')<..y'}. d * x⇧2 + e * x + f ≠ 0))))" let ?e2 = "(∃x. (∀(a, b, c)∈set a. a * x⇧2 + b * x + c = 0) ∧ (∀(a, b, c)∈set b. a * x⇧2 + b * x + c < 0) ∧ (∀(a, b, c)∈set c. a * x⇧2 + b * x + c ≤ 0) ∧ (∀(a, b, c)∈set d. a * x⇧2 + b * x + c ≠ 0))" have h1: "?e1 ⟶ ?e2" using qe_backwards by auto have h2: "?e2 ⟶ ?e1" using qe_forwards by auto have "(?e2 ⟶ ?e1) ∧ (?e1 ⟶ ?e2) " using h1 h2 by force then have "?e2 ⟷ ?e1" using iff_conv_conj_imp[of ?e1 ?e2] by presburger then show ?thesis by auto qed fun eq_fun :: "real ⇒ real ⇒ real ⇒ (real*real*real) list ⇒ (real*real*real) list ⇒ (real*real*real) list ⇒ (real*real*real) list ⇒ bool" where "eq_fun a' b' c' eq les leq neq = ((a' = 0 ∧ b' ≠ 0) ∧ (∀a∈set eq. case a of (d, e, f) ⇒ d * (- c' / b')⇧2 + e * (- c' / b') + f = 0) ∧ (∀a∈set les. case a of (d, e, f) ⇒ d * (- c' / b')⇧2 + e * (- c' / b') + f < 0) ∧ (∀a∈set leq. case a of (d, e, f) ⇒ d * (- c' / b')⇧2 + e * (- c' / b') + f ≤ 0) ∧ (∀a∈set neq. case a of (d, e, f) ⇒ d * (- c' / b')⇧2 + e * (- c' / b') + f ≠ 0) ∨ a' ≠ 0 ∧ - b'⇧2 + 4 * a' * c' ≤ 0 ∧ ((∀a∈set eq. case a of (d, e, f) ⇒ d * ((- b' + 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a'))⇧2 + e * ((- b' + 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a')) + f = 0) ∧ (∀a∈set les. case a of (d, e, f) ⇒ d * ((- b' + 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a'))⇧2 + e * ((- b' + 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a')) + f < 0) ∧ (∀a∈set leq. case a of (d, e, f) ⇒ d * ((- b' + 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a'))⇧2 + e * ((- b' + 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a')) + f ≤ 0) ∧ (∀a∈set neq. case a of (d, e, f) ⇒ d * ((- b' + 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a'))⇧2 + e * ((- b' + 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a')) + f ≠ 0) ∨ (∀a∈set eq. case a of (d, e, f) ⇒ d * ((- b' + - 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a'))⇧2 + e * ((- b' + - 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a')) + f = 0) ∧ (∀a∈set les. case a of (d, e, f) ⇒ d * ((- b' + - 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a'))⇧2 + e * ((- b' + - 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a')) + f < 0) ∧ (∀a∈set leq. case a of (d, e, f) ⇒ d * ((- b' + - 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a'))⇧2 + e * ((- b' + - 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a')) + f ≤ 0) ∧ (∀a∈set neq. case a of (d, e, f) ⇒ d * ((- b' + - 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a'))⇧2 + e * ((- b' + - 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a')) + f ≠ 0)))" fun les_fun :: "real ⇒ real ⇒ real ⇒ (real*real*real) list ⇒ (real*real*real) list ⇒ (real*real*real) list ⇒ (real*real*real) list ⇒ bool" where "les_fun a' b' c' eq les leq neq = ((a' = 0 ∧ b' ≠ 0) ∧ (∀(d, e, f)∈set eq. ∃y'>- c' / b'. ∀x∈{- c' / b'<..y'}. d * x⇧2 + e * x + f = 0) ∧ (∀(d, e, f)∈set les. ∃y'>- c' / b'. ∀x∈{- c' / b'<..y'}. d * x⇧2 + e * x + f < 0) ∧ (∀(d, e, f)∈set leq. ∃y'>- c' / b'. ∀x∈{- c' / b'<..y'}. d * x⇧2 + e * x + f ≤ 0) ∧ (∀(d, e, f)∈set neq. ∃y'>- c' / b'. ∀x∈{- c' / b'<..y'}. d * x⇧2 + e * x + f ≠ 0) ∨ a' ≠ 0 ∧ - b'⇧2 + 4 * a' * c' ≤ 0 ∧ ((∀(d, e, f)∈set eq. ∃y'>(- b' + 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a'). ∀x∈{(- b' + 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a')<..y'}. d * x⇧2 + e * x + f = 0) ∧ (∀(d, e, f)∈set les. ∃y'>(- b' + 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a'). ∀x∈{(- b' + 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a')<..y'}. d * x⇧2 + e * x + f < 0) ∧ (∀(d, e, f)∈set leq. ∃y'>(- b' + 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a'). ∀x∈{(- b' + 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a')<..y'}. d * x⇧2 + e * x + f ≤ 0) ∧ (∀(d, e, f)∈set neq. ∃y'>(- b' + 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a'). ∀x∈{(- b' + 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a')<..y'}. d * x⇧2 + e * x + f ≠ 0) ∨ (∀(d, e, f)∈set eq. ∃y'>(- b' + - 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a'). ∀x∈{(- b' + - 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a')<..y'}. d * x⇧2 + e * x + f = 0) ∧ (∀(d, e, f)∈set les. ∃y'>(- b' + - 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a'). ∀x∈{(- b' + - 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a')<..y'}. d * x⇧2 + e * x + f < 0) ∧ (∀(d, e, f)∈set leq. ∃y'>(- b' + - 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a'). ∀x∈{(- b' + - 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a')<..y'}. d * x⇧2 + e * x + f ≤ 0) ∧ (∀(d, e, f)∈set neq. ∃y'>(- b' + - 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a'). ∀x∈{(- b' + - 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a')<..y'}. d * x⇧2 + e * x + f ≠ 0)))" lemma general_qe' : (* Direct substitution F(x) *) assumes "F = (λx. (∀(a,b,c)∈set eq . a*x⇧2+b*x+c=0)∧ (∀(a,b,c)∈set les. a*x⇧2+b*x+c<0)∧ (∀(a,b,c)∈set leq. a*x⇧2+b*x+c≤0)∧ (∀(a,b,c)∈set neq. a*x⇧2+b*x+c≠0))" (* Substitution of r+ε into F *) assumes "Fε = (λr. (∀(a,b,c)∈set eq. ∃y>r.∀x∈{r<..y}. a*x⇧2+b*x+c=0) ∧ (∀(a,b,c)∈set les. ∃y>r.∀x∈{r<..y}. a*x⇧2+b*x+c<0) ∧ (∀(a,b,c)∈set leq. ∃y>r.∀x∈{r<..y}. a*x⇧2+b*x+c≤0) ∧ (∀(a,b,c)∈set neq. ∃y>r.∀x∈{r<..y}. a*x⇧2+b*x+c≠0) )" (* Substitution of -∞ into F *) assumes "F⇩i⇩n⇩f = ( (∀(a,b,c)∈set eq. ∃x. ∀y<x. a*y⇧2+b*y+c=0) ∧ (∀(a,b,c)∈set les. ∃x. ∀y<x. a*y⇧2+b*y+c<0) ∧ (∀(a,b,c)∈set leq. ∃x. ∀y<x. a*y⇧2+b*y+c≤0) ∧ (∀(a,b,c)∈set neq. ∃x. ∀y<x. a*y⇧2+b*y+c≠0) )" (* finds linear or quadratic roots of a polynomial *) assumes "roots = (λ(a,b,c). if a=0 ∧ b≠0 then {-c/b}::real set else if a≠0 ∧ b⇧2-4*a*c≥0 then {(-b+sqrt(b⇧2-4*a*c))/(2*a)}∪{(-b-sqrt(b⇧2-4*a*c))/(2*a)} else {})" (* all the root of each atom *) assumes "A = ⋃(roots ` (set eq))" assumes "B = ⋃(roots ` (set les))" assumes "C = ⋃(roots ` (set leq))" assumes "D = ⋃(roots ` (set neq))" (* Quantifier Elimination *) shows "(∃x. F(x)) = (F⇩i⇩n⇩f∨(∃r∈A. F r)∨(∃r∈B. Fε r)∨(∃r∈C. F r)∨(∃r∈D. Fε r))" proof- { fix X have "(∃(a, b, c)∈set X. eq_fun a b c eq les leq neq) = (∃x∈F ` ⋃(roots ` (set X)). x)" proof(induction X) case Nil then show ?case by auto next case (Cons p X) have h1: "(∃x∈F ` ⋃ (roots ` set (p # X)). x) = ((∃x∈F ` roots p. x) ∨ (∃x∈F ` ⋃ (roots ` set X). x))" by auto have h2 :"(case p of (a,b,c) ⇒ eq_fun a b c eq les leq neq) = (∃x∈F ` roots p. x)" apply(cases p) unfolding assms apply simp by linarith show ?case unfolding h1 Cons[symmetric] using h2 by auto qed } then have eq : "⋀X. (∃(a, b, c)∈set X. eq_fun a b c eq les leq neq) = (∃x∈F ` ⋃ (roots ` set X). x)" by auto { fix X have "(∃(a, b, c)∈set X. les_fun a b c eq les leq neq) = (∃x∈Fε ` ⋃(roots ` (set X)). x)" proof(induction X) case Nil then show ?case by auto next case (Cons p X) have h1: "(∃x∈Fε ` ⋃ (roots ` set (p # X)). x) = ((∃x∈Fε ` roots p. x) ∨ (∃x∈Fε ` ⋃ (roots ` set X). x))" by auto have h2 :"(case p of (a,b,c) ⇒ les_fun a b c eq les leq neq) = (∃x∈Fε ` roots p. x)" apply(cases p) unfolding assms apply simp by linarith show ?case unfolding h1 Cons[symmetric] using h2 by auto qed } then have les : "⋀X. (∃(a, b, c)∈set X. les_fun a b c eq les leq neq) = (∃x∈Fε ` ⋃ (roots ` set X). x)" by auto have inf : "(∀(a, b, c)∈set eq. a = 0 ∧ b = 0 ∧ c = 0) = (∀x∈set eq. case x of (a, b, c) ⇒ ∃x. ∀y<x. a * y⇧2 + b * y + c = 0)" proof(induction eq) case Nil then show ?case by auto next case (Cons p eq) then show ?case proof(cases p) case (fields a b c) show ?thesis unfolding fields using infzeros[of _ a b c] Cons by auto qed qed show ?thesis using qe[of "eq" "les" "leq" "neq"] using eq[of eq] eq[of leq] les[of les] les[of neq] unfolding inf assms by auto qed lemma general_qe'' : (* Direct substitution F(x) *) assumes "S = {(=), (<), (≤), (≠)}" assumes "finite (X (=))" assumes "finite (X (<))" assumes "finite (X (≤))" assumes "finite (X (≠))" assumes "F = (λx. ∀rel∈S. ∀(a,b,c)∈(X rel). rel (a*x⇧2+b*x+c) 0)" (* Substitution of r+ε into F *) assumes "Fε = (λr. ∀rel∈S. ∀(a,b,c)∈(X rel). ∃y>r.∀x∈{r<..y}. rel (a*x⇧2+b*x+c) 0)" (* Substitution of -∞ into F *) assumes "F⇩i⇩n⇩f = (∀rel∈S. ∀(a,b,c)∈(X rel). ∃x. ∀y<x. rel (a*y⇧2+b*y+c) 0)" (* finds linear or quadratic roots of a polynomial *) assumes "roots = (λ(a,b,c). if a=0 ∧ b≠0 then {-c/b}::real set else if a≠0 ∧ b⇧2-4*a*c≥0 then {(-b+sqrt(b⇧2-4*a*c))/(2*a)}∪{(-b-sqrt(b⇧2-4*a*c))/(2*a)} else {})" (* all the root of each atom *) assumes "A = ⋃(roots ` ((X (=))))" assumes "B = ⋃(roots ` ((X (<))))" assumes "C = ⋃(roots ` ((X (≤))))" assumes "D = ⋃(roots ` ((X (≠))))" (* Quantifier Elimination *) shows "(∃x. F(x)) = (F⇩i⇩n⇩f∨(∃r∈A. F r)∨(∃r∈B. Fε r)∨(∃r∈C. F r)∨(∃r∈D. Fε r))" proof- define less where "less = (λ(a::real,b::real,c::real).λ(a',b',c'). a<a'∨ (a=a'∧ (b<b'∨(b=b'∧c<c'))))" define leq where "leq = (λx.λy. x=y ∨ less x y)" have linorder: "class.linorder leq less" unfolding class.linorder_def class.order_def class.preorder_def class.order_axioms_def class.linorder_axioms_def less_def leq_def by auto show ?thesis using assms(6-8) unfolding assms(1) apply simp using general_qe'[OF _ _ _ assms(9), of F "List.linorder.sorted_list_of_set leq (X (=))" "List.linorder.sorted_list_of_set leq (X (<))" "List.linorder.sorted_list_of_set leq (X (≤))" "List.linorder.sorted_list_of_set leq (X (≠))" Fε F⇩i⇩n⇩f A B C D] unfolding List.linorder.set_sorted_list_of_set[OF linorder assms(2)] List.linorder.set_sorted_list_of_set[OF linorder assms(3)] List.linorder.set_sorted_list_of_set[OF linorder assms(4)] List.linorder.set_sorted_list_of_set[OF linorder assms(5)] using assms(10-13)by auto qed theorem general_qe : (* finite sets of atoms involving = < ≤ and ≠*) assumes "R = {(=), (<), (≤), (≠)}" assumes "∀rel∈R. finite (Atoms rel)" (* Direct substitution F(x) *) assumes "F = (λx. ∀rel∈R. ∀(a,b,c)∈(Atoms rel). rel (a*x⇧2+b*x+c) 0)" (* Substitution of r+ε into F *) assumes "Fε = (λr. ∀rel∈R. ∀(a,b,c)∈(Atoms rel). ∃y>r.∀x∈{r<..y}. rel (a*x⇧2+b*x+c) 0)" (* Substitution of -∞ into F *) assumes "F⇩i⇩n⇩f = (∀rel∈R. ∀(a,b,c)∈(Atoms rel). ∃x. ∀y<x. rel (a*y⇧2+b*y+c) 0)" (* finds linear or quadratic roots of a polynomial *) assumes "roots = (λ(a,b,c). if a=0 ∧ b≠0 then {-c/b} else if a≠0 ∧ b⇧2-4*a*c≥0 then {(-b+sqrt(b⇧2-4*a*c))/(2*a)}∪{(-b-sqrt(b⇧2-4*a*c))/(2*a)} else {})" (* Quantifier Elimination *) shows "(∃x. F(x)) = (F⇩i⇩n⇩f ∨ (∃r∈⋃(roots ` (Atoms (=) ∪ Atoms (≤))). F r) ∨ (∃r∈⋃(roots ` (Atoms (<) ∪ Atoms (≠))). Fε r))" using general_qe''[OF assms(1) _ _ _ _ assms(3-6) refl refl refl refl] using assms(2) unfolding assms(1) by auto end
section "Multivariate Polynomials Extension" theory MPolyExtension imports Polynomials.Polynomials (*MPoly_Type_Efficient_Code*) Polynomials.MPoly_Type_Class_FMap begin subsection "Definition Lifting" lift_definition coeff_code::"'a::zero mpoly ⇒ (nat ⇒⇩0 nat) ⇒ 'a" is "lookup" . lemma coeff_code[code]: "coeff = coeff_code" unfolding coeff_def apply(transfer) by auto lemma coeff_transfer[transfer_rule]:― ‹TODO: coeff should be defined via lifting, this gives us the illusion› "rel_fun cr_mpoly (=) lookup coeff" using coeff_code.transfer[folded coeff_code] . lemmas coeff_add = coeff_add[symmetric] lemma plus_monom_zero[simp]: "p + MPoly_Type.monom m 0 = p" by transfer auto lift_definition monomials::"'a::zero mpoly ⇒ (nat ⇒⇩0 nat) set" is "Poly_Mapping.keys::((nat⇒⇩0nat) ⇒⇩0 'a) ⇒ _ set" . lemma mpoly_induct [case_names monom sum]:― ‹TODO: overwrites @{thm mpoly_induct}› assumes monom:"⋀m a. P (MPoly_Type.monom m a)" and sum:"(⋀p1 p2 m a. P p1 ⟹ P p2 ⟹ p2 = (MPoly_Type.monom m a) ⟹ m ∉ monomials p1 ⟹ a ≠ 0 ⟹ P (p1+p2))" shows "P p" using assms proof (induction p rule: mpoly_induct) case (sum p1 p2 m a) then show ?case by (cases "a = 0") (auto simp: monomials.rep_eq) qed simp value "monomials ((Var 0 + Const (3::int) * Var 1)^2)" lemma Sum_any_lookup_times_eq: "(∑k. ((lookup (x::'a⇒⇩0('b::comm_semiring_1)) (k::'a)) * ((f:: 'a⇒('b::comm_semiring_1)) k))) = (∑k∈keys x. (lookup x (k::'a)) * (f k))" by (subst Sum_any.conditionalize) (auto simp: in_keys_iff intro!: Sum_any.cong) lemma Prod_any_power_lookup_eq: "(∏k::'a. f k ^ lookup (x::'a⇒⇩0nat) k) = (∏k∈keys x. f k ^ lookup x k)" by (subst Prod_any.conditionalize) (auto simp: in_keys_iff intro!: Prod_any.cong) lemma insertion_monom: "insertion i (monom m a) = a * (∏k∈keys m. i k ^ lookup m k)" by transfer (auto simp: insertion_aux_def insertion_fun_def Sum_any_lookup_times_eq Prod_any_power_lookup_eq) lemma monomials_monom[simp]: "monomials (monom m a) = (if a = 0 then {} else {m})" by transfer auto lemma finite_monomials[simp]: "finite (monomials m)" by transfer auto lemma monomials_add_disjoint: "monomials (a + b) = monomials a ∪ monomials b" if "monomials a ∩ monomials b = {}" using that by transfer (auto simp add: keys_plus_eqI) lemma coeff_monom[simp]: "coeff (monom m a) m = a" by transfer simp lemma coeff_not_in_monomials[simp]: "coeff m x = 0" if "x ∉ monomials m" using that by transfer (simp add: in_keys_iff) code_thms insertion lemma insertion_code[code]: "insertion i mp = (∑m∈monomials mp. (coeff mp m) * (∏k∈keys m. i k ^ lookup m k))" proof (induction mp rule: mpoly_induct) case (monom m a) show ?case by (simp add: insertion_monom) next case (sum p1 p2 m a) have monomials_add: "monomials (p1 + p2) = insert m (monomials p1)" using sum.hyps by (auto simp: monomials_add_disjoint) have *: "coeff (monom m a) x = 0" if "x ∈ monomials p1" for x using sum.hyps that by (subst coeff_not_in_monomials) auto show ?case unfolding insertion_add monomials_add sum.IH using sum.hyps by (auto simp: coeff_add * algebra_simps) qed (* insertion f p takes in a mapping from natural numbers to the type of the polynomial and substitutes in the constant (f var) for each var variable in polynomial p *) code_thms insertion value "insertion (nth [1, 2.3]) ((Var 0 + Const (3::int) * Var 1)^2)" (* isolate_variable_sparse p var degree returns the coefficient of the term a*var^degree in polynomial p *) lift_definition isolate_variable_sparse::"'a::comm_monoid_add mpoly ⇒ nat ⇒ nat ⇒ 'a mpoly" is "λ(mp::'a mpoly) x d. sum (λm. monomial (coeff mp m) (Poly_Mapping.update x 0 m)) {m ∈ monomials mp. lookup m x = d}" . lemma Poly_Mapping_update_code[code]: "Poly_Mapping.update a b (Pm_fmap fm) = Pm_fmap (fmupd a b fm)" by (auto intro!: poly_mapping_eqI simp: update.rep_eq fmlookup_default_def) lemma monom_zero [simp] : "monom m 0 = 0" by (simp add: coeff_all_0) lemma remove_key_code[code]: "remove_key v (Pm_fmap fm) = Pm_fmap (fmdrop v fm)" by (auto simp: remove_key_lookup fmlookup_default_def intro!: poly_mapping_eqI) lemma extract_var_code[code]: "extract_var p v = (∑m∈monomials p. monom (remove_key v m) (monom (Poly_Mapping.single v (lookup m v)) (coeff p m)))" apply (rule extract_var_finite_set[where S="monomials p"]) using coeff_not_in_monomials by auto value "extract_var ((Var 0 + Const (3::real) * Var 1)^2) 0" (* degree p var takes in polynomial p and a variable var and finds the degree of that variable in the polynomial missing code theorems? still manages to evaluate *) code_thms degree value "degree ((Var 0 + Const (3::real) * Var 1)^2) 0" (* this function gives a set of all the variables in the polynomial *) lemma vars_code[code]: "vars p = ⋃ (keys ` monomials p)" unfolding monomials.rep_eq vars_def .. value "vars ((Var 0 + Const (3::real) * Var 1)^2)" (* return true if the polynomial contains no variables *) fun is_constant :: "'a::zero mpoly ⇒ bool" where "is_constant p = Set.is_empty (vars p)" value "is_constant (Const (0::int))" (* if the polynomial is constant, returns the real value associated with the polynomial, otherwise returns none *) fun get_if_const :: "real mpoly ⇒ real option" where "get_if_const p = (if is_constant p then Some (coeff p 0) else None)" term "coeff p 0" lemma insertionNegative : "insertion f p = - insertion f (-p)" by (metis (no_types, hide_lams) add_eq_0_iff cancel_comm_monoid_add_class.diff_cancel insertion_add insertion_zero uminus_add_conv_diff) definition derivative :: "nat ⇒ real mpoly ⇒ real mpoly" where "derivative x p = (∑i∈{0..degree p x-1}. isolate_variable_sparse p x (i+1) * (Var x)^i * (Const (i+1)))" text "get\\_coeffs $x$ $p$ gets the tuple of coefficients $a$ $b$ $c$ of the term $a*x^2+b*x+c$ in polynomial $p$" fun get_coeffs :: "nat ⇒ real mpoly ⇒ real mpoly * real mpoly * real mpoly" where "get_coeffs var x = ( isolate_variable_sparse x var 2, isolate_variable_sparse x var 1, isolate_variable_sparse x var 0) " end
text "Executable Polynomial Properties" theory ExecutiblePolyProps imports Polynomials.MPoly_Type_Univariate MPolyExtension begin text ‹(Univariate) Polynomial hiding› lifting_update poly.lifting lifting_forget poly.lifting text ‹› no_notation MPoly_Type.div (infixl "div" 70) no_notation MPoly_Type.mod (infixl "mod" 70) subsection "Lemmas with Monomial and Monomials" lemma of_nat_monomial: "of_nat p = monomial p 0" by (auto simp: poly_mapping_eq_iff lookup_of_nat fun_eq_iff lookup_single) lemma of_nat_times_monomial: "of_nat p * monomial c i = monomial (p*c) i" by (auto simp: poly_mapping_eq_iff prod_fun_def fun_eq_iff of_nat_monomial lookup_single mult_single) lemma monomial_adds_nat_iff: "monomial p i adds c ⟷ lookup c i ≥ p" for p::"nat" apply (auto simp: adds_def lookup_add) by (metis add.left_commute nat_le_iff_add remove_key_sum single_add) lemma update_minus_monomial: "Poly_Mapping.update k i (m - monomial i k) = Poly_Mapping.update k i m" by (auto simp: poly_mapping_eq_iff lookup_update update.rep_eq fun_eq_iff lookup_minus lookup_single) lemma monomials_Var: "monomials (Var x::'a::zero_neq_one mpoly) = {Poly_Mapping.single x 1}" by transfer (auto simp: Var⇩0_def) lemma monomials_Const: "monomials (Const x) = (if x = 0 then {} else {0})" by transfer' (auto simp: Const⇩0_def) lemma coeff_eq_zero_iff: "MPoly_Type.coeff c p = 0 ⟷ p ∉ monomials c" by transfer (simp add: not_in_keys_iff_lookup_eq_zero) lemma monomials_1[simp]: "monomials 1 = {0}" by transfer auto lemma monomials_and_monoms: shows "(k ∈ monomials m) = (∃ (a::nat). a ≠ 0 ∧ (monomials (MPoly_Type.monom k a)) ⊆ monomials m)" proof - show ?thesis using monomials_monom by auto qed lemma mult_monomials_dir_one: shows "monomials (p*q) ⊆ {a+b | a b . a ∈ monomials p ∧ b ∈ monomials q}" using monomials_and_monoms mult_monom by (simp add: keys_mult monomials.rep_eq times_mpoly.rep_eq) lemma monom_eq_zero_iff[simp]: "MPoly_Type.monom a b = 0 ⟷ b = 0" by (metis MPolyExtension.coeff_monom MPolyExtension.monom_zero) lemma update_eq_plus_monomial: "v ≥ lookup m k ⟹ Poly_Mapping.update k v m = m + monomial (v - lookup m k) k" for v n::nat by transfer auto lemma coeff_monom_mult': "MPoly_Type.coeff ((MPoly_Type.monom m' a) * q) (m'm) = a * MPoly_Type.coeff q (m'm - m')" if *: "m'm = m' + (m'm - m')" by (subst *) (rule More_MPoly_Type.coeff_monom_mult) lemma monomials_zero[simp]: "monomials 0 = {}" by transfer auto lemma in_monomials_iff: "x ∈ monomials m ⟷ MPoly_Type.coeff m x ≠ 0" using coeff_eq_zero_iff[of m x] by auto lemma monomials_monom_mult: "monomials (MPoly_Type.monom mon a * q) = (if a = 0 then {} else (+) mon ` monomials q)" for q::"'a::semiring_no_zero_divisors mpoly" apply auto subgoal by transfer' (auto elim!: in_keys_timesE) subgoal by (simp add: in_monomials_iff More_MPoly_Type.coeff_monom_mult) done subsection "Simplification Lemmas for Const 0 and Const 1" lemma add_zero : "P + Const 0 = P" proof - have h:"P + 0 = P" using add_0_right by auto show ?thesis unfolding Const_def using h by (simp add: Const⇩0_zero zero_mpoly.abs_eq) qed (* example *) lemma add_zero_example : "((Var 0)^2 - (Const 1)) + Const 0 = ((Var 0)^2 - (Const 1))" proof - show ?thesis by (simp add : add_zero) qed lemma mult_zero_left : "Const 0 * P = Const 0" proof - have h:"0*P = 0" by simp show ?thesis unfolding Const_def using h by (simp add: Const⇩0_zero zero_mpoly_def) qed lemma mult_zero_right : "P * Const 0 = Const 0" by (metis mult_zero_left mult_zero_right) lemma mult_one_left : "Const 1 * (P :: real mpoly) = P" by (simp add: Const.abs_eq Const⇩0_one one_mpoly_def) lemma mult_one_right : "(P::real mpoly) * Const 1 = P" by (simp add: Const.abs_eq Const⇩0_one one_mpoly_def) subsection "Coefficient Lemmas" lemma coeff_zero[simp]: "MPoly_Type.coeff 0 x = 0" by transfer auto lemma coeff_sum: "MPoly_Type.coeff (sum f S) x = sum (λi. MPoly_Type.coeff (f i) x) S" apply (induction S rule: infinite_finite_induct) apply (auto) by (metis More_MPoly_Type.coeff_add) lemma coeff_mult_Var: "MPoly_Type.coeff (x * Var i ^ p) c = (MPoly_Type.coeff x (c - monomial p i) when lookup c i ≥ p)" by transfer' (auto simp: Var⇩0_def pprod.monomial_power lookup_times_monomial_right of_nat_times_monomial monomial_adds_nat_iff) lemma lookup_update_self[simp]: "Poly_Mapping.update i (lookup m i) m = m" by (auto simp: lookup_update intro!: poly_mapping_eqI) lemma coeff_Const: "MPoly_Type.coeff (Const p) m = (p when m = 0)" by transfer' (auto simp: Const⇩0_def lookup_single) lemma coeff_Var: "MPoly_Type.coeff (Var p) m = (1 when m = monomial 1 p)" by transfer' (auto simp: Var⇩0_def lookup_single when_def) subsection "Miscellaneous" lemma update_0_0[simp]: "Poly_Mapping.update x 0 0 = 0" by (metis lookup_update_self lookup_zero) lemma mpoly_eq_iff: "p = q ⟷ (∀m. MPoly_Type.coeff p m = MPoly_Type.coeff q m)" by transfer (auto simp: poly_mapping_eqI) lemma power_both_sides : assumes Ah : "(A::real) ≥0" assumes Bh : "(B::real) ≥0" shows "(A≤B) = (A^2≤B^2)" using Ah Bh by (meson power2_le_imp_le power_mono) lemma in_list_induct_helper: assumes "set(xs)⊆X" assumes "P []" assumes "(⋀x. x∈X ⟹ ( ⋀xs. P xs ⟹ P (x # xs)))" shows "P xs" using assms(1) proof(induction xs) case Nil then show ?case using assms by auto next case (Cons a xs) then show ?case using assms(3) by auto qed theorem in_list_induct [case_names Nil Cons]: assumes "P []" assumes "(⋀x. x∈set(xs) ⟹ ( ⋀xs. P xs ⟹ P (x # xs)))" shows "P xs" using in_list_induct_helper[of xs "set(xs)" P] using assms by auto subsubsection "Keys and vars" lemma inKeys_inVars : "a≠0 ⟹ x ∈ keys m ⟹ x ∈ vars(MPoly_Type.monom m a)" by(simp add: vars_def) lemma notInKeys_notInVars : "x ∉ keys m ⟹ x ∉ vars(MPoly_Type.monom m a)" by(simp add: vars_def) lemma lookupNotIn : "x ∉ keys m ⟹ lookup m x = 0" by (simp add: in_keys_iff) subsection "Degree Lemmas" lemma degree_le_iff: "MPoly_Type.degree p x ≤ k ⟷ (∀m∈monomials p. lookup m x ≤ k)" by transfer simp lemma degree_less_iff: "MPoly_Type.degree p x < k ⟷ (k>0 ∧ (∀m∈monomials p. lookup m x < k))" by (transfer fixing: k) (cases "k = 0"; simp) lemma degree_ge_iff: "k > 0 ⟹ MPoly_Type.degree p x ≥ k ⟷ (∃m∈monomials p. lookup m x ≥ k)" using Max_ge_iff by (meson degree_less_iff not_less) lemma degree_greater_iff: "MPoly_Type.degree p x > k ⟷ (∃m∈monomials p. lookup m x > k)" by transfer' (auto simp: Max_gr_iff) lemma degree_eq_iff: "MPoly_Type.degree p x = k ⟷ (if k = 0 then (∀m∈monomials p. lookup m x = 0) else (∃m∈monomials p. lookup m x = k) ∧ (∀m∈monomials p. lookup m x ≤ k))" by (subst eq_iff) (force simp: degree_le_iff degree_ge_iff intro!: antisym) declare poly_mapping.lookup_inject[simp del] lemma lookup_eq_and_update_lemma: "lookup m var = deg ∧ Poly_Mapping.update var 0 m = x ⟷ m = Poly_Mapping.update var deg x ∧ lookup x var = 0" unfolding poly_mapping_eq_iff by (force simp: update.rep_eq fun_eq_iff) lemma degree_const : "MPoly_Type.degree (Const (z::real)) (x::nat) = 0" by (simp add: degree_eq_iff monomials_Const) lemma degree_one : "MPoly_Type.degree (Var x :: real mpoly) x = 1" by(simp add: degree_eq_iff monomials_Var) subsection "Lemmas on treating a multivariate polynomial as univariate " lemma coeff_isolate_variable_sparse: "MPoly_Type.coeff (isolate_variable_sparse p var deg) x = (if lookup x var = 0 then MPoly_Type.coeff p (Poly_Mapping.update var deg x) else 0)" apply (transfer fixing: x var deg p) unfolding lookup_sum unfolding lookup_single apply (auto simp: when_def) apply (subst sum.inter_filter[symmetric]) subgoal by simp subgoal by (simp add: lookup_eq_and_update_lemma Collect_conv_if) by (auto intro!: sum.neutral simp add: lookup_update) lemma isovarspar_sum: "isolate_variable_sparse (p+q) var deg = isolate_variable_sparse (p) var deg + isolate_variable_sparse (q) var deg" apply (auto simp add: mpoly_eq_iff coeff_isolate_variable_sparse ) apply (metis More_MPoly_Type.coeff_add coeff_isolate_variable_sparse) by (metis More_MPoly_Type.coeff_add add.comm_neutral coeff_isolate_variable_sparse less_numeral_extra(3)) lemma isolate_zero[simp]: "isolate_variable_sparse 0 var n = 0" by transfer' (auto simp: mpoly_eq_iff) lemma coeff_isolate_variable_sparse_minus_monomial: "MPoly_Type.coeff (isolate_variable_sparse mp var i) (m - monomial i var) = (if lookup m var ≤ i then MPoly_Type.coeff mp (Poly_Mapping.update var i m) else 0)" by (simp add: coeff_isolate_variable_sparse lookup_minus update_minus_monomial) lemma sum_over_zero: "(mp::real mpoly) = (∑i::nat ≤MPoly_Type.degree mp x. isolate_variable_sparse mp x i * Var x^i)" by (auto simp add: mpoly_eq_iff coeff_sum coeff_mult_Var if_if_eq_conj not_le coeff_isolate_variable_sparse_minus_monomial when_def lookup_update degree_less_iff simp flip: eq_iff intro!: coeff_not_in_monomials) lemma const_lookup_zero : "isolate_variable_sparse (Const p ::real mpoly) (x::nat) (0::nat) = Const p" by (auto simp: mpoly_eq_iff coeff_isolate_variable_sparse coeff_Const when_def) (metis lookup_update_self) lemma const_lookup_suc : "isolate_variable_sparse (Const p :: real mpoly) x (Suc i) = 0" apply(auto simp add: mpoly_eq_iff coeff_isolate_variable_sparse coeff_Const when_def) by (metis lookup_update lookup_zero nat.distinct(1)) lemma isovar_greater_degree : "∀i > MPoly_Type.degree p var. isolate_variable_sparse p var i = 0" apply(auto simp add: mpoly_eq_iff coeff_isolate_variable_sparse degree_less_iff) by (metis coeff_not_in_monomials less_irrefl_nat lookup_update) lemma isolate_var_0 : "isolate_variable_sparse (Var x::real mpoly) x 0 = 0" apply(auto simp add: mpoly_eq_iff coeff_isolate_variable_sparse coeff_Var when_def) by (metis gr0I lookup_single_eq lookup_update_self n_not_Suc_n) lemma isolate_var_one : "isolate_variable_sparse (Var x :: real mpoly) x 1 = 1" by (auto simp add: mpoly_eq_iff coeff_isolate_variable_sparse coeff_Var coeff_eq_zero_iff) (smt More_MPoly_Type.coeff_monom One_nat_def add_diff_cancel_left' lookup_eq_and_update_lemma lookup_single_eq lookup_update_self monom_one plus_1_eq_Suc single_diff single_zero update_minus_monomial) lemma isovarspase_monom : assumes notInKeys : "x ∉ keys m" assumes notZero : "a ≠ 0" shows "isolate_variable_sparse (MPoly_Type.monom m a) x 0 = (MPoly_Type.monom m a :: real mpoly)" using assms by (auto simp add: mpoly_eq_iff coeff_isolate_variable_sparse coeff_eq_zero_iff in_keys_iff) (metis lookup_update_self) lemma isolate_variable_spase_zero : "lookup m x = 0 ⟹ insertion (nth L) ((MPoly_Type.monom m a)::real mpoly) = 0 ⟹ a ≠ 0 ⟹ insertion (nth L) (isolate_variable_sparse (MPoly_Type.monom m a) x 0) = 0" by (simp add: isovarspase_monom lookup_eq_zero_in_keys_contradict notInKeys_notInVars) lemma isovarsparNotIn : "x ∉ vars (p::real mpoly) ⟹ isolate_variable_sparse p x 0 = p" proof(induction p rule: mpoly_induct) case (monom m a) then show ?case apply(cases "a=0") by (simp_all add: isovarspase_monom vars_monom_keys) next case (sum p1 p2 m a) then show ?case by (simp add: monomials.rep_eq vars_add_monom isovarspar_sum) qed lemma degree0isovarspar : assumes deg0 : "MPoly_Type.degree (p::real mpoly) x = 0" shows "isolate_variable_sparse p x 0 = p" proof - have h1 : "p = (∑i::nat ≤MPoly_Type.degree p x. isolate_variable_sparse p x i * Var x ^ i)" using sum_over_zero by auto have h2a : "∀f. (∑i::nat ≤0. f i) = f 0" apply(simp add: sum_def) by (metis add.right_neutral comm_monoid_add_class.sum_def finite.emptyI insert_absorb insert_not_empty sum.empty sum.insert) have h2 : "p = isolate_variable_sparse p x 0 * Var x ^ 0" using deg0 h1 h2a by auto show ?thesis using h2 by auto qed subsection "Summation Lemmas" lemma summation_normalized : assumes nonzero : "(B ::real) ≠0" shows "(∑i = 0..<((n::nat)+1). (f i :: real) * B ^ (n - i)) = (∑i = 0..<(n+1). (f i) / (B ^ i)) * (B^n)" proof - have h1a : "∀x::real. ((∑i = 0..<(n+1). (f i) / (B ^ i)) * x = (∑i = 0..<(n+1). ((f i) / (B ^ i)) * x))" apply(induction n ) apply(auto) by (simp add: distrib_right) have h1 : "(∑i = 0..<(n+1). (f i) / (B ^ i)) * (B^n) = (∑i = 0..<(n+1). ((f i) / (B ^ i)) * (B^n))" using h1a by auto have h2 : "(∑i = 0..<(n+1). ((f i) / (B ^ i)) * (B^n)) = (∑i = 0..<(n+1). (f i) * ((B^n) / (B ^ i)))" by auto have h3 : "(∑i = 0..<(n+1). (f i) * ((B^n) / (B ^ i))) = (∑i = 0..<(n+1). (f i) * B ^ (n - i))" using add.right_neutral nonzero power_diff by fastforce show ?thesis using h1 h2 h3 by auto qed lemma normalize_summation : assumes nonzero : "(B::real)≠0" shows "(∑i = 0..<n+1. f i * B ^ (n - i))= 0 ⟷ (∑i = 0..<(n::nat)+1. (f i::real) / (B ^ i)) = 0" proof - have pow_zero : "∀i. B^(i :: nat)≠0" using nonzero by(auto) have single_division_zero : "∀X. B*(X::real)=0 ⟷ X=0" using nonzero by(auto) have h1: "(∑i = 0..<n+1. (f i) / (B ^ i)) = 0 ⟷ ((∑i = 0..<n+1. (f i) / (B ^ i)))*B^n = 0" using nonzero single_division_zero by(auto) have h2: "((∑i = 0..<n+1. (f i) / (B ^ i))*(B^n)) = ((∑i = 0..<n+1. (f i) * (B ^ (n- i))))" using summation_normalized nonzero by auto show ?thesis using h1 h2 by auto qed lemma normalize_summation_less : assumes nonzero : "(B::real)≠0" shows "(∑i = 0..<(n+1). (f i) * B ^ (n - i)) * B ^ (n mod 2) < 0 ⟷ (∑i = 0..<((n::nat)+1). (f i::real) / (B ^ i)) < 0" proof - have h1 : "(∑i = 0..<(n+1). (f i) * B ^ (n - i)) * B ^ (n mod 2) < 0 ⟷ (∑i = 0..<(n+1). (f i) / (B ^ i)) * (B^n) * B ^ (n mod 2) < 0" using summation_normalized nonzero by auto have h2a : "n mod 2 = 0 ∨ n mod 2 = 1" by auto have h2b : "n mod 2 = 1 ⟹ odd n" by auto have h2c : "(B^n) * B ^ (n mod 2) > 0" using h2a h2b apply auto using nonzero apply presburger by (metis even_Suc mult.commute nonzero power_Suc zero_less_power_eq) have h2 : "∀x. ((x * (B^n) * B ^ (n mod 2) < 0) = (x<0))" using h2c using mult.assoc by (metis mult_less_0_iff not_square_less_zero) show ?thesis using h1 h2 by auto qed subsection "Additional Lemmas with Vars" lemma not_in_isovarspar : "isolate_variable_sparse (p::real mpoly) var x = (q::real mpoly) ⟹ var∉(vars q)" apply(simp add: isolate_variable_sparse_def vars_def) proof - assume a1: "MPoly (∑m | m ∈ monomials p ∧ lookup m var = x. monomial (MPoly_Type.coeff p m) (Poly_Mapping.update var 0 m)) = q" { fix pp :: "nat ⇒⇩0 nat" have "isolate_variable_sparse p var x = q" using a1 isolate_variable_sparse.abs_eq by blast then have "var ∉ keys pp ∨ pp ∉ keys (mapping_of q)" by (metis (no_types) coeff_def coeff_isolate_variable_sparse in_keys_iff) } then show "∀p∈keys (mapping_of q). var ∉ keys p" by meson qed lemma not_in_add : "var∉(vars (p::real mpoly)) ⟹ var∉(vars (q::real mpoly)) ⟹ var∉(vars (p+q))" by (meson UnE in_mono vars_add) lemma not_in_mult : "var∉(vars (p::real mpoly)) ⟹ var∉(vars (q::real mpoly)) ⟹ var∉(vars (p*q))" by (meson UnE in_mono vars_mult) lemma not_in_neg : "var∉(vars(p::real mpoly)) ⟷ var∉(vars(-p))" proof - have h: "var ∉ (vars (-1::real mpoly))" by (metis add_diff_cancel_right' add_neg_numeral_special(8) isolate_var_one isolate_zero isovarsparNotIn isovarspar_sum not_in_isovarspar) show ?thesis using not_in_mult using h by fastforce qed lemma not_in_sub : "var∉(vars (p::real mpoly)) ⟹ var∉(vars (q::real mpoly)) ⟹ var∉(vars (p-q))" using not_in_add not_in_neg by fastforce lemma not_in_pow : "var∉(vars(p::real mpoly)) ⟹ var∉(vars(p^i))" proof (induction i) case 0 then show ?case using isolate_var_one not_in_isovarspar by (metis power_0) next case (Suc i) then show ?case using not_in_mult by simp qed lemma not_in_sum_var: "(∀i. var∉(vars(f(i)::real mpoly))) ⟹ var∉(vars(∑i∈{0..<(n::nat)}.f(i)))" proof (induction n) case 0 then show ?case using isolate_zero not_in_isovarspar by fastforce next case (Suc n) have h1: "(sum f {0..<Suc n}) = (sum f {0..< n}) + (f n)" using sum.atLeast0_lessThan_Suc by blast have h2: "var ∉ vars (f n)" by (simp add: Suc.prems) then show ?case using h1 vars_add by (simp add: Suc.IH Suc.prems not_in_add) qed lemma not_in_sum : "(∀i. var∉(vars(f(i)::real mpoly))) ⟹ ∀(n::nat). var∉(vars(∑i∈{0..<n}.f(i)))" using not_in_sum_var by blast lemma not_contains_insertion_helper : "∀x∈keys (mapping_of p). var ∉ keys x ⟹ (⋀k f. (k ∉ keys f) = (lookup f k = 0)) ⟹ lookup (mapping_of p) a = 0 ∨ (∏aa. (if aa < length L then L[var := y] ! aa else 0) ^ lookup a aa) = (∏aa. (if aa < length L then L[var := x] ! aa else 0) ^ lookup a aa)" apply(cases "lookup (mapping_of p) a = 0") apply auto apply(rule Prod_any.cong) apply auto using lookupNotIn nth_list_update_neq power_0 by smt lemma not_contains_insertion : assumes notIn : "var ∉ vars (p:: real mpoly)" assumes exists : "insertion (nth_default 0 (list_update L var x)) p = val" shows "insertion (nth_default 0 (list_update L var y)) p = val" using notIn exists apply(simp add: insertion_def insertion_aux_def insertion_fun_def) unfolding vars_def nth_default_def using not_in_keys_iff_lookup_eq_zero apply auto apply(rule Sum_any.cong) apply simp using not_contains_insertion_helper[of p var _ L y x] proof - fix a :: "nat ⇒⇩0 nat" assume a1: "∀x∈keys (mapping_of p). var ∉ keys x" assume "⋀k f. ((k::'a) ∉ keys f) = (lookup f k = 0)" then show "lookup (mapping_of p) a = 0 ∨ (∏n. (if n < length L then L[var := y] ! n else 0) ^ lookup a n) = (∏n. (if n < length L then L[var := x] ! n else 0) ^ lookup a n)" using a1 ‹⋀a. ⟦∀x∈keys (mapping_of p). var ∉ keys x; ⋀k f. (k ∉ keys f) = (lookup f k = 0)⟧ ⟹ lookup (mapping_of p) a = 0 ∨ (∏aa. (if aa < length L then L[var := y] ! aa else 0) ^ lookup a aa) = (∏aa. (if aa < length L then L[var := x] ! aa else 0) ^ lookup a aa)› by blast qed subsection "Insertion Lemmas" lemma insertion_sum_var : "((insertion f (∑i∈{0..<(n::nat)}.g(i))) = (∑i∈{0..<n}. insertion f (g i)))" proof (induction n) case 0 then show ?case by auto next case (Suc n) then show ?case by (simp add: insertion_add) qed (* changed to explicitly typecast n as a nat *) lemma insertion_sum : "∀(n::nat). ((insertion f (∑i∈{0..<n}.g(i))) = (∑i∈{0..<n}. insertion f (g i)))" using insertion_sum_var by blast lemma insertion_sum' : "⋀(n::nat). ((insertion f (∑i≤n. g(i))) = (∑i≤n. insertion f (g i)))" by (metis (no_types, lifting) fun_sum_commute insertion_add insertion_zero sum.cong) lemma insertion_pow : "insertion f (p^i) = (insertion f p)^i" proof (induction i) case 0 then show ?case by auto next case (Suc n) then show ?case by (simp add: insertion_mult) qed lemma insertion_neg : "insertion f (-p) = -insertion f p" by (metis add.inverse_inverse insertionNegative) lemma insertion_var : "length L > var ⟹ insertion (nth_default 0 (list_update L var x)) (Var var) = x" by (auto simp: monomials_Var coeff_Var insertion_code nth_default_def) lemma insertion_var_zero : "insertion (nth_default 0 (x#xs)) (Var 0) = x" using insertion_var by fastforce lemma notIn_insertion_sub : "x∉vars(p::real mpoly) ⟹ x∉vars(q::real mpoly) ⟹ insertion f (p-q) = insertion f p - insertion f q" by (metis ab_group_add_class.ab_diff_conv_add_uminus insertion_add insertion_neg) lemma insertion_sub : "insertion f (A-B :: real mpoly) = insertion f A - insertion f B" using insertion_neg insertion_add by (metis uminus_add_conv_diff) lemma insertion_four : "insertion ((nth_default 0) xs) 4 = 4" by (metis (no_types, lifting) insertion_add insertion_one numeral_plus_numeral one_add_one semiring_norm(2) semiring_norm(6)) lemma insertion_add_ind_basecase: "insertion (nth (list_update L var x)) ((∑i::nat ≤ 0. isolate_variable_sparse p var i * (Var var)^i)) = (∑i = 0..<(0+1). insertion (nth (list_update L var x)) (isolate_variable_sparse p var i * (Var var)^i))" proof - have h1: "((∑i::nat ≤ 0. isolate_variable_sparse p var i * (Var var)^i)) = (isolate_variable_sparse p var 0 * (Var var)^0)" by auto show ?thesis using h1 by auto qed lemma insertion_add_ind: "insertion (nth_default 0 (list_update L var x)) ((∑i::nat ≤ d. isolate_variable_sparse p var i * (Var var)^i)) = (∑i = 0..<(d+1). insertion (nth_default 0 (list_update L var x)) (isolate_variable_sparse p var i * (Var var)^i))" proof (induction d) case 0 then show ?case using insertion_add_ind_basecase nth_default_def by auto next case (Suc n) then show ?case using insertion_add apply auto by (simp add: insertion_add) qed lemma sum_over_degree_insertion : assumes lLength : "length L > var" assumes deg : "MPoly_Type.degree (p::real mpoly) var = d" shows "(∑i = 0..<(d+1). insertion (nth_default 0 (list_update L var x)) (isolate_variable_sparse p var i) * (x^i)) = insertion (nth_default 0 (list_update L var x)) p" proof - have h1: "(p::real mpoly) = (∑i::nat ≤(MPoly_Type.degree p var). isolate_variable_sparse p var i * (Var var)^i)" using sum_over_zero by auto have h2: "insertion (nth_default 0 (list_update L var x)) p = insertion (nth_default 0 (list_update L var x)) ((∑i::nat ≤ d. isolate_variable_sparse p var i * (Var var)^i))" using h1 deg by auto have h3: "insertion (nth_default 0 (list_update L var x)) p = (∑i = 0..<(d+1). insertion (nth_default 0 (list_update L var x)) (isolate_variable_sparse p var i * (Var var)^i))" using h2 insertion_add_ind nth_default_def by (simp add: ) show ?thesis using h3 insertion_var insertion_pow by (metis (no_types, lifting) insertion_mult lLength sum.cong) qed lemma insertion_isovarspars_free : "insertion (nth_default 0 (list_update L var x)) (isolate_variable_sparse (p::real mpoly) var (i::nat)) =insertion (nth_default 0 (list_update L var y)) (isolate_variable_sparse (p::real mpoly) var (i::nat))" proof - have h : "var ∉ vars(isolate_variable_sparse (p::real mpoly) var (i::nat))" by (simp add: not_in_isovarspar) then show ?thesis using not_contains_insertion by blast qed lemma insertion_zero : "insertion f (Const 0 ::real mpoly) = 0" by (metis add_cancel_right_right add_zero insertion_zero) lemma insertion_one : "insertion f (Const 1 ::real mpoly) = 1" by (metis insertion_one mult.right_neutral mult_one_left) lemma insertion_const : "insertion f (Const c::real mpoly) = (c::real)" by (auto simp: monomials_Const coeff_Const insertion_code) subsection "Putting Things Together" subsubsection "More Degree Lemmas" lemma degree_add_leq : assumes h1 : "MPoly_Type.degree a var ≤ x" assumes h2 : "MPoly_Type.degree b var ≤ x" shows "MPoly_Type.degree (a+b) var ≤ x" using degree_eq_iff coeff_add coeff_not_in_monomials by (smt (z3) More_MPoly_Type.coeff_add add.left_neutral coeff_eq_zero_iff degree_le_iff h1 h2) lemma degree_add_less : assumes h1 : "MPoly_Type.degree a var < x" assumes h2 : "MPoly_Type.degree b var < x" shows "MPoly_Type.degree (a+b) var < x" proof - obtain pp :: "nat ⇒ nat ⇒ 'a mpoly ⇒ nat ⇒⇩0 nat" where "∀x0 x1 x2. (∃v3. v3 ∈ monomials x2 ∧ ¬ lookup v3 x1 < x0) = (pp x0 x1 x2 ∈ monomials x2 ∧ ¬ lookup (pp x0 x1 x2) x1 < x0)" by moura then have f1: "∀m n na. (¬ MPoly_Type.degree m n < na ∨ 0 < na ∧ (∀p. p ∉ monomials m ∨ lookup p n < na)) ∧ (MPoly_Type.degree m n < na ∨ ¬ 0 < na ∨ pp na n m ∈ monomials m ∧ ¬ lookup (pp na n m) n < na)" by (metis (no_types) degree_less_iff) then have "0 < x ∧ (∀p. p ∉ monomials a ∨ lookup p var < x)" using assms(1) by presburger then show ?thesis using f1 by (metis MPolyExtension.coeff_add add.left_neutral assms(2) coeff_eq_zero_iff) qed lemma degree_sum : "(∀i∈{0..n::nat}. MPoly_Type.degree (f i :: real mpoly) var ≤ x) ⟹ (MPoly_Type.degree (∑x∈{0..n}. f x) var) ≤ x" proof(induction n) case 0 then show ?case by auto next case (Suc n) then show ?case by(simp add: degree_add_leq) qed lemma degree_sum_less : "(∀i∈{0..n::nat}. MPoly_Type.degree (f i :: real mpoly) var < x) ⟹ (MPoly_Type.degree (∑x∈{0..n}. f x) var) < x" proof(induction n) case 0 then show ?case by auto next case (Suc n) then show ?case by(simp add: degree_add_less) qed lemma varNotIn_degree : assumes "var ∉ vars p" shows "MPoly_Type.degree p var = 0" proof- have "∀m∈monomials p. lookup m var = 0" using assms unfolding vars_def keys_def using monomials.rep_eq by fastforce then show ?thesis using degree_less_iff by blast qed lemma degree_mult_leq : assumes pnonzero: "(p::real mpoly)≠0" assumes qnonzero: "(q::real mpoly)≠0" shows "MPoly_Type.degree ((p::real mpoly) * (q::real mpoly)) var ≤ (MPoly_Type.degree p var) + (MPoly_Type.degree q var)" proof(cases "MPoly_Type.degree (p*q) var =0") case True then show ?thesis by simp next case False have hp: "∀m∈monomials p. lookup m var ≤ MPoly_Type.degree p var" using degree_eq_iff by (metis zero_le) have hq: "∀m∈monomials q. lookup m var ≤ MPoly_Type.degree q var" using degree_eq_iff by (metis zero_le) have hpq: "∀m∈{a+b | a b . a ∈ monomials p ∧ b ∈ monomials q}. lookup m var ≤ (MPoly_Type.degree p var) + (MPoly_Type.degree q var)" by (smt add_le_mono hp hq mem_Collect_eq plus_poly_mapping.rep_eq) have h1: "(∀m∈monomials (p*q). lookup m var ≤ (MPoly_Type.degree p var) + (MPoly_Type.degree q var))" using mult_monomials_dir_one hpq by blast then show ?thesis using h1 degree_eq_iff False by (simp add: degree_le_iff) qed lemma degree_exists_monom: assumes "p≠0" shows "∃m∈monomials p. lookup m var = MPoly_Type.degree p var" proof(cases "MPoly_Type.degree p var =0") case True have h1: "∃m∈monomials p. lookup m var = 0" unfolding monomials_def by (metis True assms(1) aux degree_eq_iff in_keys_iff mapping_of_inject monomials.rep_eq monomials_def zero_mpoly.rep_eq) then show ?thesis using h1 using True by simp next case False then show ?thesis using degree_eq_iff assms(1) apply(auto) by (metis degree_eq_iff dual_order.strict_iff_order) qed lemma degree_not_exists_monom: assumes "p≠0" shows "¬ (∃ m∈monomials p. lookup m var > MPoly_Type.degree p var)" proof - show ?thesis using degree_less_iff by blast qed lemma degree_monom: "MPoly_Type.degree (MPoly_Type.monom x y) v = (if y = 0 then 0 else lookup x v)" by (auto simp: degree_eq_iff) lemma degree_plus_disjoint: "MPoly_Type.degree (p + MPoly_Type.monom m c) v = max (MPoly_Type.degree p v) (MPoly_Type.degree (MPoly_Type.monom m c) v)" if "m ∉ monomials p" for p::"real mpoly" using that apply (subst degree_eq_iff) apply (auto simp: monomials_add_disjoint) apply (auto simp: degree_eq_iff degree_monom) apply (metis MPoly_Type.degree_zero degree_exists_monom less_numeral_extra(3)) using degree_le_iff apply blast using degree_eq_iff apply (metis max_def neq0_conv) apply (metis degree_eq_iff max.coboundedI1 neq0_conv) apply (metis MPoly_Type.degree_zero degree_exists_monom max_def zero_le) using degree_le_iff max.cobounded1 by blast subsubsection "More isolate\\_variable\\_sparse lemmas" lemma isolate_variable_sparse_ne_zeroD: "isolate_variable_sparse mp v x ≠ 0 ⟹ x ≤ MPoly_Type.degree mp v" using isovar_greater_degree leI by blast context includes poly.lifting begin lift_definition mpoly_to_nested_poly::"'a::comm_monoid_add mpoly ⇒ nat ⇒ 'a mpoly Polynomial.poly" is "λ(mp::'a mpoly) (v::nat) (p::nat). isolate_variable_sparse mp v p" ― ‹note \<^const>‹extract_var› nests the other way around› unfolding MOST_iff_cofinite proof - fix mp::"'a mpoly" and v::nat have "{p. isolate_variable_sparse mp v p ≠ 0} ⊆ {0..MPoly_Type.degree mp v}" (is "?s ⊆ _") by (auto dest!: isolate_variable_sparse_ne_zeroD) also have "finite …" by simp finally (finite_subset) show "finite ?s" . qed lemma degree_eq_0_mpoly_to_nested_polyI: "mpoly_to_nested_poly mp v = 0 ⟹ MPoly_Type.degree mp v = 0" apply transfer' apply (simp add: degree_eq_iff) apply transfer' apply (auto simp: fun_eq_iff) proof - fix mpa :: "'a mpoly" and va :: nat and m :: "nat ⇒⇩0 nat" assume a1: "∀x. (∑m | m ∈ monomials mpa ∧ lookup m va = x. monomial (MPoly_Type.coeff mpa m) (Poly_Mapping.update va 0 m)) = 0" assume a2: "m ∈ monomials mpa" have f3: "∀m p. lookup (mapping_of m) p ≠ (0::'a) ∨ p ∉ monomials m" by (metis (full_types) coeff_def coeff_eq_zero_iff) have f4: "∀n. mapping_of (isolate_variable_sparse mpa va n) = 0" using a1 by (simp add: isolate_variable_sparse.rep_eq) have "∀p n. lookup 0 (p::nat ⇒⇩0 nat) = (0::'a) ∨ (0::nat) = n" by simp then show "lookup m va = 0" using f4 f3 a2 by (metis coeff_def coeff_isolate_variable_sparse lookup_eq_and_update_lemma) qed lemma coeff_eq_zero_mpoly_to_nested_polyD: "mpoly_to_nested_poly mp v = 0 ⟹ MPoly_Type.coeff mp 0 = 0" apply transfer' apply transfer' by (metis (no_types) coeff_def coeff_isolate_variable_sparse isolate_variable_sparse.rep_eq lookup_zero update_0_0) lemma mpoly_to_nested_poly_eq_zero_iff[simp]: "mpoly_to_nested_poly mp v = 0 ⟷ mp = 0" apply (auto simp: coeff_eq_zero_mpoly_to_nested_polyD degree_eq_0_mpoly_to_nested_polyI) proof - show "mpoly_to_nested_poly mp v = 0 ⟹ mp = 0" apply (frule degree_eq_0_mpoly_to_nested_polyI) apply (frule coeff_eq_zero_mpoly_to_nested_polyD) apply (transfer' fixing: mp v) apply (transfer' fixing: mp v) apply (auto simp: fun_eq_iff mpoly_eq_iff intro!: sum.neutral) proof - fix m :: "nat ⇒⇩0 nat" assume a1: "∀x. (∑m | m ∈ monomials mp ∧ lookup m v = x. monomial (MPoly_Type.coeff mp m) (Poly_Mapping.update v 0 m)) = 0" assume a2: "MPoly_Type.degree mp v = 0" have "∀n. isolate_variable_sparse mp v n = 0" using a1 by (simp add: isolate_variable_sparse.abs_eq zero_mpoly.abs_eq) then have f3: "∀p. MPoly_Type.coeff mp p = MPoly_Type.coeff 0 p ∨ lookup p v ≠ 0" by (metis (no_types) coeff_isolate_variable_sparse lookup_update_self) then show "MPoly_Type.coeff mp m = 0" using a2 coeff_zero by (metis coeff_not_in_monomials degree_eq_iff) qed show "mp = 0 ⟹ mpoly_to_nested_poly 0 v = 0" subgoal apply transfer' apply transfer' by (auto simp: fun_eq_iff intro!: sum.neutral) done qed lemma isolate_variable_sparse_degree_eq_zero_iff: "isolate_variable_sparse p v (MPoly_Type.degree p v) = 0 ⟷ p = 0" apply (transfer') apply auto proof - fix pa :: "'a mpoly" and va :: nat assume "(∑m | m ∈ monomials pa ∧ lookup m va = MPoly_Type.degree pa va. monomial (MPoly_Type.coeff pa m) (Poly_Mapping.update va 0 m)) = 0" then have "mapping_of (isolate_variable_sparse pa va (MPoly_Type.degree pa va)) = 0" by (simp add: isolate_variable_sparse.rep_eq) then show "pa = 0" by (metis (no_types) coeff_def coeff_eq_zero_iff coeff_isolate_variable_sparse degree_exists_monom lookup_eq_and_update_lemma lookup_zero) qed lemma degree_eq_univariate_degree: "MPoly_Type.degree p v = (if p = 0 then 0 else Polynomial.degree (mpoly_to_nested_poly p v))" apply auto apply (rule antisym) subgoal apply (rule Polynomial.le_degree) apply (auto simp: ) apply transfer' by (simp add: isolate_variable_sparse_degree_eq_zero_iff) subgoal apply (rule Polynomial.degree_le) apply (auto simp: elim!: degree_eq_zeroE) apply transfer' by (simp add: isovar_greater_degree) done lemma compute_mpoly_to_nested_poly[code]: "coeffs (mpoly_to_nested_poly mp v) = (if mp = 0 then [] else map (isolate_variable_sparse mp v) [0..<Suc(MPoly_Type.degree mp v)])" unfolding coeffs_def unfolding mpoly_to_nested_poly_eq_zero_iff degree_eq_univariate_degree apply auto subgoal by transfer' (rule refl) by transfer' (rule refl) end lemma isolate_variable_sparse_monom: "isolate_variable_sparse (MPoly_Type.monom m a) v i = (if a = 0 ∨ lookup m v ≠ i then 0 else MPoly_Type.monom (Poly_Mapping.update v 0 m) a)" proof - have *: "{x. x = m ∧ lookup x v = i} = (if lookup m v = i then {m} else {})" by auto show ?thesis by (transfer' fixing: m a v i) (simp add:*) qed lemma isolate_variable_sparse_monom_mult: "isolate_variable_sparse (MPoly_Type.monom m a * q) v n = (if n ≥ lookup m v then MPoly_Type.monom (Poly_Mapping.update v 0 m) a * isolate_variable_sparse q v (n - lookup m v) else 0)" for q::"'a::semiring_no_zero_divisors mpoly" apply (auto simp: MPoly_Type.mult_monom) subgoal apply transfer' subgoal for mon v i a q apply (auto simp add: monomials_monom_mult sum_distrib_left) apply (rule sum.reindex_bij_witness_not_neutral[where j="λa. a - mon" and i="λa. mon + a" and S'="{}" and T'="{}" ]) apply (auto simp: lookup_add) apply (auto simp: poly_mapping_eq_iff fun_eq_iff single.rep_eq Poly_Mapping.mult_single) apply (auto simp: when_def More_MPoly_Type.coeff_monom_mult) by (auto simp: lookup_update lookup_add split: if_splits) done subgoal apply transfer' apply (auto intro!: sum.neutral simp: monomials_monom_mult ) apply (rule poly_mapping_eqI) apply (auto simp: lookup_single when_def) by (simp add: lookup_add) done lemma isolate_variable_sparse_mult: "isolate_variable_sparse (p * q) v n = (∑i≤n. isolate_variable_sparse p v i * isolate_variable_sparse q v (n - i))" for p q::"'a::semiring_no_zero_divisors mpoly" proof (induction p rule: mpoly_induct) case (monom m a) then show ?case by (cases "a = 0") (auto simp add: mpoly_eq_iff coeff_sum coeff_mult if_conn if_distrib if_distribR isolate_variable_sparse_monom isolate_variable_sparse_monom_mult cong: if_cong) next case (sum p1 p2 m a) then show ?case by (simp add: distrib_right isovarspar_sum sum.distrib) qed subsubsection "More Miscellaneous" lemma var_not_in_Const : "var∉vars (Const x :: real mpoly)" unfolding vars_def keys_def by (smt UN_iff coeff_def coeff_isolate_variable_sparse const_lookup_zero keys_def lookup_eq_zero_in_keys_contradict) lemma mpoly_to_nested_poly_mult: "mpoly_to_nested_poly (p * q) v = mpoly_to_nested_poly p v * mpoly_to_nested_poly q v" for p q::"'a::{comm_semiring_0, semiring_no_zero_divisors} mpoly" by (auto simp: poly_eq_iff coeff_mult mpoly_to_nested_poly.rep_eq isolate_variable_sparse_mult) lemma get_if_const_insertion : assumes "get_if_const (p::real mpoly) = Some r" shows "insertion f p = r" proof- have "Set.is_empty (vars p)" apply(cases "Set.is_empty (vars p)") apply(simp) using assms by(simp) then have "(MPoly_Type.coeff p 0) = r" using assms by simp then show ?thesis by (metis Set.is_empty_def ‹Set.is_empty (vars p)› empty_iff insertion_irrelevant_vars insertion_trivial) qed subsubsection "Yet more Degree Lemmas" lemma degree_mult: fixes p q::"'a::{comm_semiring_0, ring_1_no_zero_divisors} mpoly" assumes "p ≠ 0" assumes "q ≠ 0" shows "MPoly_Type.degree (p * q) v = MPoly_Type.degree p v + MPoly_Type.degree q v" using assms by (auto simp add: degree_eq_univariate_degree mpoly_to_nested_poly_mult Polynomial.degree_mult_eq) lemma degree_eq: assumes "(p::real mpoly) = (q:: real mpoly)" shows "MPoly_Type.degree p x = MPoly_Type.degree q x" by (simp add: assms) lemma degree_var_i : "MPoly_Type.degree (((Var x)^i:: real mpoly)) x = i" proof (induct i) case 0 then show ?case using degree_const by simp next case (Suc i) have multh: "(Var x)^(Suc i) = ((Var x)^i::real mpoly) * (Var x:: real mpoly)" using power_Suc2 by blast have deg0h: "MPoly_Type.degree 0 x = 0" by simp have deg1h: "MPoly_Type.degree (Var x::real mpoly) x = 1" using degree_one by blast have nonzeroh1: "(Var x:: real mpoly) ≠ 0" using degree_eq deg0h deg1h by auto have nonzeroh2: "((Var x)^i:: real mpoly) ≠ 0" using degree_eq deg0h Suc.hyps by (metis one_neq_zero power_0) have sumh: "(MPoly_Type.degree (((Var x)^i:: real mpoly) * (Var x:: real mpoly)) x) = (MPoly_Type.degree ((Var x)^i::real mpoly) x) + (MPoly_Type.degree (Var x::real mpoly) x)" using degree_mult[where p = "(Var x)^i::real mpoly", where q = "Var x::real mpoly"] nonzeroh1 nonzeroh2 by blast then show ?case using sumh deg1h by (metis Suc.hyps Suc_eq_plus1 multh) qed lemma degree_less_sum: assumes "MPoly_Type.degree (p::real mpoly) var = n" assumes "MPoly_Type.degree (q::real mpoly) var = m" assumes "m < n" shows "MPoly_Type.degree (p + q) var = n" proof - have h1: "n > 0" using assms(3) neq0_conv by blast have h2: "(∃m∈monomials p. lookup m var = n) ∧ (∀m∈monomials p. lookup m var ≤ n)" using degree_eq_iff assms(1) by (metis degree_ge_iff h1 order_refl) have h3: "(∃m∈monomials (p + q). lookup m var = n)" using h2 by (metis MPolyExtension.coeff_add add.right_neutral assms(2) assms(3) coeff_eq_zero_iff degree_not_exists_monom) have h4: "(∀m∈monomials (p + q). lookup m var ≤ n)" using h2 assms(3) assms(2) using degree_add_leq degree_le_iff dual_order.strict_iff_order by blast show ?thesis using degree_eq_iff h3 h4 by (metis assms(3) gr_implies_not0) qed lemma degree_less_sum': assumes "MPoly_Type.degree (p::real mpoly) var = n" assumes "MPoly_Type.degree (q::real mpoly) var = m" assumes "n < m" shows "MPoly_Type.degree (p + q) var = m" using degree_less_sum[OF assms(2) assms(1) assms(3)] by (simp add: add.commute) (* Result on the degree of the derivative *) lemma nonzero_const_is_nonzero: assumes "(k::real) ≠ 0" shows "((Const k)::real mpoly) ≠ 0" by (metis MPoly_Type.insertion_zero assms insertion_const) lemma degree_derivative : assumes "MPoly_Type.degree p x > 0" shows "MPoly_Type.degree p x = MPoly_Type.degree (derivative x p) x + 1" proof - define f where "f i = (isolate_variable_sparse p x (i+1) * (Var x)^(i) * (Const (i+1)))" for i define n where "n = MPoly_Type.degree p x-1" have d : "∃m∈monomials p. lookup m x = n+1" using n_def degree_eq_iff assms by (metis add.commute less_not_refl2 less_one linordered_semidom_class.add_diff_inverse) have h1a : "∀i. MPoly_Type.degree (isolate_variable_sparse p x i) x = 0" by (simp add: not_in_isovarspar varNotIn_degree) have h1b : "∀i::nat. MPoly_Type.degree ((Var x)^i:: real mpoly) x = i" using degree_var_i by auto have h1c1 : "∀i. (Var(x)^(i)::real mpoly)≠0" by (metis MPoly_Type.degree_zero h1b power_0 zero_neq_one) have h1c1var: "((Var x)^i:: real mpoly) ≠ 0" using h1c1 by blast have h1c2 : "((Const ((i::nat) + 1))::real mpoly)≠0" using nonzero_const_is_nonzero by auto have h1c3: "(isolate_variable_sparse p x (n + 1)) ≠ 0" using d by (metis One_nat_def Suc_pred add.commute assms isolate_variable_sparse_degree_eq_zero_iff n_def not_gr_zero not_in_isovarspar plus_1_eq_Suc varNotIn_degree) have h3: "(isolate_variable_sparse p x (i+1) = 0) ⟶ (MPoly_Type.degree (f i) x) = 0" by (simp add: f_def) have degh1: "(MPoly_Type.degree (((Const ((i::nat)+1))::real mpoly)*(Var x)^i) x) = ((MPoly_Type.degree ((Const (i+1))::real mpoly) x) + (MPoly_Type.degree ((Var x)^i:: real mpoly) x))" using h1c2 h1c1var degree_mult[where p="((Const ((i::nat)+1))::real mpoly)", where q="((Var x)^i:: real mpoly)"] by blast then have degh2: "(MPoly_Type.degree (((Const ((i::nat)+1))::real mpoly)*(Var x)^i) x) = i" using degree_var_i degree_const by simp have nonzerohyp: "(((Const ((i::nat)+1))::real mpoly)*(Var x)^i) ≠ 0" proof (induct i) case 0 then show ?case by (simp add: nonzero_const_is_nonzero) next case (Suc i) then show ?case using degree_eq degh2 by (metis Suc_eq_plus1 h1c1 mult_eq_0_iff nat.simps(3) nonzero_const_is_nonzero of_nat_eq_0_iff) qed have h4a1: "(isolate_variable_sparse p x (i+1) ≠ 0) ⟶ (MPoly_Type.degree (isolate_variable_sparse p x (i+1) * ((Var x)^(i) * (Const (i+1)))::real mpoly) x = (MPoly_Type.degree (isolate_variable_sparse p x (i+1):: real mpoly) x) + (MPoly_Type.degree (((Const (i+1)) * (Var x)^(i))::real mpoly) x))" using nonzerohyp degree_mult[where p = "(isolate_variable_sparse p x (i+1))::real mpoly", where q = "((Const (i+1)) * (Var x)^(i)):: real mpoly", where v = "x"] by (simp add: mult.commute) have h4: "(isolate_variable_sparse p x (i+1) ≠ 0) ⟶ (MPoly_Type.degree (f i) x) = i" using h4a1 f_def degh2 h1a by (metis (no_types, hide_lams) add.left_neutral mult.commute mult.left_commute of_nat_1 of_nat_add) have h5: "(MPoly_Type.degree (f i) x) ≤ i" using h3 h4 by auto have h6: "(MPoly_Type.degree (f n) x) = n" using h1c3 h4 by (smt One_nat_def add.right_neutral add_Suc_right degree_const degree_mult divisors_zero f_def h1a h1b h1c1 mult.commute nonzero_const_is_nonzero of_nat_1 of_nat_add of_nat_neq_0) have h7a: "derivative x p = (∑i∈{0..MPoly_Type.degree p x-1}. isolate_variable_sparse p x (i+1) * (Var x)^i * (Const (i+1)))" using derivative_def by auto have h7b: "(∑i∈{0..MPoly_Type.degree p x-1}. isolate_variable_sparse p x (i+1) * (Var x)^i * (Const (i+1))) = (∑i∈{0..MPoly_Type.degree p x-1}. (f i))" using f_def by (metis Suc_eq_plus1 add.commute semiring_1_class.of_nat_simps(2)) have h7c: "derivative x p = (∑i∈{0..MPoly_Type.degree p x-1}. (f i))" using h7a h7b by auto have h7: "derivative x p = (∑i∈{0..n}. (f i))" using n_def h7c by blast have h8: "n > 0 ⟶ ((MPoly_Type.degree (∑i∈{0..(n-1)}. (f i)) x) < n)" proof (induct n) case 0 then show ?case by blast next case (Suc n) then show ?case using h5 degree_less_sum by (smt add_cancel_right_right atLeastAtMost_iff degree_const degree_mult degree_sum_less degree_var_i diff_Suc_1 f_def h1a le_imp_less_Suc mult.commute mult_eq_0_iff) qed have h9a: "n = 0 ⟶ MPoly_Type.degree (∑i∈{0..n}. (f i)) x = n" using h6 by auto have h9b: "n > 0 ⟶ MPoly_Type.degree (∑i∈{0..n}. (f i)) x = n" proof - have h9bhyp: "n > 0 ⟶ (MPoly_Type.degree (∑i∈{0..n}. (f i)) x = MPoly_Type.degree ((∑i∈{0..(n-1)}. (f i)) + (f n)) x)" by (metis Suc_diff_1 sum.atLeast0_atMost_Suc) have h9bhyp2: "n > 0 ⟶ ((MPoly_Type.degree ((∑i∈{0..(n-1)}. (f i)) + (f n)) x) = n)" using h6 h8 degree_less_sum by (simp add: add.commute) then show ?thesis using h9bhyp2 h9bhyp by linarith qed have h9: "MPoly_Type.degree (∑i∈{0..n}. (f i)) x = n" using h9a h9b by blast have h10: "MPoly_Type.degree (derivative x p) x = n" using h9 h7 by simp show ?thesis using h10 n_def using assms by linarith qed lemma express_poly : assumes h : "MPoly_Type.degree (p::real mpoly) var = 1 ∨ MPoly_Type.degree p var = 2" shows "p = (isolate_variable_sparse p var 2)*(Var var)^2 +(isolate_variable_sparse p var 1)*(Var var) +(isolate_variable_sparse p var 0)" proof- have h1a: "MPoly_Type.degree p var = 1 ⟶ p = isolate_variable_sparse p var 0 + isolate_variable_sparse p var 1 * Var var" using sum_over_zero[where mp="p",where x="var"] by auto have h1b: "MPoly_Type.degree p var = 1 ⟶ isolate_variable_sparse p var 2 = 0" using isovar_greater_degree by (simp add: isovar_greater_degree) have h1: "MPoly_Type.degree p var = 1 ⟶ p = isolate_variable_sparse p var 0 + isolate_variable_sparse p var 1 * Var var + isolate_variable_sparse p var 2 * (Var var)^2" using h1a h1b by auto have h2a: "MPoly_Type.degree p var = 2 ⟶ p = (∑i::nat ≤ 2. isolate_variable_sparse p var i * Var var^i)" using sum_over_zero[where mp="p", where x="var"] by auto have h2b: "(∑i::nat ≤ 2. isolate_variable_sparse p var i * Var var^i) = (∑i::nat ≤ 1. isolate_variable_sparse p var i * Var var^i) + isolate_variable_sparse p var 2 * (Var var)^2" apply auto by (simp add: numerals(2)) have h2: "MPoly_Type.degree p var = 2 ⟶ p = isolate_variable_sparse p var 0 + isolate_variable_sparse p var 1 * Var var + isolate_variable_sparse p var 2 * (Var var)^2" using h2a h2b by auto have h3: "isolate_variable_sparse p var 0 + isolate_variable_sparse p var 1 * Var var + isolate_variable_sparse p var 2 * (Var var)^2 = isolate_variable_sparse p var 2 * (Var var)^2 + isolate_variable_sparse p var 1 * Var var + isolate_variable_sparse p var 0" by (simp add: add.commute) show ?thesis using h h1 h2 h3 by presburger qed lemma degree_isovarspar : "MPoly_Type.degree (isolate_variable_sparse (p::real mpoly) x i) x = 0" using not_in_isovarspar varNotIn_degree by blast end
section "Atoms" theory PolyAtoms imports ExecutiblePolyProps begin subsection "Definition" datatype (atoms: 'a) fm = TrueF | FalseF | Atom 'a | And "'a fm" "'a fm" | Or "'a fm" "'a fm" | Neg "'a fm" | ExQ "'a fm" | AllQ "'a fm" | ExN "nat" "'a fm" | AllN "nat" "'a fm" definition neg where "neg φ = (if φ=TrueF then FalseF else if φ=FalseF then TrueF else Neg φ)" definition "and" :: "'a fm ⇒ 'a fm ⇒ 'a fm" where "and φ⇩1 φ⇩2 = (if φ⇩1=TrueF then φ⇩2 else if φ⇩2=TrueF then φ⇩1 else if φ⇩1=FalseF ∨ φ⇩2=FalseF then FalseF else And φ⇩1 φ⇩2)" definition or :: "'a fm ⇒ 'a fm ⇒ 'a fm" where "or φ⇩1 φ⇩2 = (if φ⇩1=FalseF then φ⇩2 else if φ⇩2=FalseF then φ⇩1 else if φ⇩1=TrueF ∨ φ⇩2=TrueF then TrueF else Or φ⇩1 φ⇩2)" definition list_conj :: "'a fm list ⇒ 'a fm" where "list_conj fs = foldr and fs TrueF" definition list_disj :: "'a fm list ⇒ 'a fm" where "list_disj fs = foldr or fs FalseF" text " The atom datatype corresponds to the defined in Tobias's LinearQuantifierElim. " datatype atom = Less "real mpoly" | Eq "real mpoly" | Leq "real mpoly" | Neq "real mpoly" text " For each atom, the real mpoly corresponds to a polynomial from the Polynomials library where we allow for real valued coefficients. The variables in the polynomials are in De Bruijn notation where variable 0 corresponds to the variable of the innermost quantifier, then variable 1 is the next quantifier out from that, and so on. Any variable number greater than the number of quantifiers is a free variable. This means that we have a list of infinite free variables we can pick from and if we want to refer to the ith free variable (indexed at 0) within an atom that is bound in j quantifiers, then we would use var (i+j). The polynomials are all standardized so that they are compared to a 0 on the right. This means the atom Less p corresponds to $p\\leq0$ and the atom Eq p corresponds to $p=0$ and so on. This restriction doesn't lose any generality and having all 4 of these kinds of atoms prevents loss of efficiency as the negation of these atoms do not introduce additional logical connectives. The following aNeg function demonstrates this. " fun aNeg :: "atom ⇒ atom" where "aNeg (Less p) = Leq (-p)" | "aNeg (Eq p) = Neq p" | "aNeg (Leq p) = Less (-p)" | "aNeg (Neq p) = Eq p" subsection "Evaluation" text " In order to do any proofs with these atoms, we need a method of comparing two atoms to check if they are equal. Instead of trying to manipulate the polynomials to a standard form to compare them, it is a lot easier to plug in values for every variable and check if the results are equal. If every single real value input for each variable matches in truth value for both atoms, then they are equal. aEval a l corresponds to plugging in the real value list l into the variables of atom a and then evaluating the truth value of it " fun aEval :: "atom ⇒ real list ⇒ bool" where "aEval (Eq p) L = (insertion (nth_default 0 L) p = 0)" | "aEval (Less p) L = (insertion (nth_default 0 L) p < 0)" | "aEval (Leq p) L = (insertion (nth_default 0 L) p ≤ 0)" | "aEval (Neq p) L = (insertion (nth_default 0 L) p ≠ 0)" text " aNeg\\_aEval shows the general format for how things are proven equal. Plugging in the values to an original atom a will results in the opposite truth value if we transformed with the aNeg function. " lemma aNeg_aEval : "aEval a L ⟷ (¬ aEval (aNeg a) L)" apply(cases a) apply(auto) apply(smt insertionNegative) apply(smt insertionNegative) apply(smt insertionNegative) apply(smt insertionNegative) done text " We can extend this to formulas instead of just atoms. Given a formula in prenex normal form, we simply iterate through and apply the quantifiers " fun eval :: "atom fm ⇒ real list ⇒ bool" where "eval (Atom a) Γ = aEval a Γ" | "eval (TrueF) _ = True" | "eval (FalseF) _ = False" | "eval (And φ ψ) Γ = ((eval φ Γ) ∧ (eval ψ Γ))" | "eval (Or φ ψ) Γ = ((eval φ Γ) ∨ (eval ψ Γ))" | "eval (Neg φ) Γ = (¬ (eval φ Γ))" | "eval (ExQ φ) Γ = (∃x. (eval φ (x#Γ)))" | "eval (AllQ φ) Γ = (∀x. (eval φ (x#Γ)))"| "eval (AllN i φ) Γ = (∀l. length l = i ⟶ (eval φ (l @ Γ)))"| "eval (ExN i φ) Γ = (∃l. length l = i ∧ (eval φ (l @ Γ)))" lemma "eval (ExQ (Or (Atom A) (Atom B))) xs = eval (Or (ExQ(Atom A)) (ExQ(Atom B))) xs" by(auto) lemma eval_neg_neg : "eval (neg (neg f)) L ⟷ eval f L" by (simp add: neg_def) lemma eval_neg : "(¬ eval (neg f) L) ⟷ eval f L" by (simp add: neg_def) lemma eval_and : "eval (and a b) L ⟷ (eval a L ∧ eval b L)" by (simp add: and_def) lemma eval_or : "eval (or a b) L ⟷ (eval a L ∨ eval b L)" by (simp add: or_def) lemma eval_Or : "eval (Or a b) L ⟷ (eval a L ∨ eval b L)" by (simp) lemma eval_And : "eval (And a b) L ⟷ (eval a L ∧ eval b L)" by (simp) lemma eval_not : "eval (neg a) L ⟷ ¬(eval a L)" by (simp add: neg_def) lemma eval_true : "eval TrueF L" by simp lemma eval_false : "¬(eval FalseF L)" by simp lemma eval_Neg : "eval (Neg φ) L = eval (neg φ) L" by (simp add: eval_not) lemma eval_Neg_Neg : "eval (Neg (Neg φ)) L = eval φ L" by (simp add: eval_not) lemma eval_Neg_And : "eval (Neg (And φ ψ)) L = eval (Or (Neg φ) (Neg ψ)) L" by simp lemma aEval_leq : "aEval (Leq p) L = (aEval (Less p) L ∨ aEval (Eq p) L)" by auto text "This function is misleading because it is true iff the variable given doesn't occur as a free variable in the atom fm" fun freeIn :: "nat ⇒ atom fm ⇒ bool" where "freeIn var (Atom(Eq p)) = (var ∉ (vars p))"| "freeIn var (Atom(Less p)) = (var ∉ (vars p))"| "freeIn var (Atom(Leq p)) = (var ∉ (vars p))"| "freeIn var (Atom(Neq p)) = (var ∉ (vars p))"| "freeIn var (TrueF) = True"| "freeIn var (FalseF) = True"| "freeIn var (And a b) = ((freeIn var a) ∧ (freeIn var b))"| "freeIn var (Or a b) = ((freeIn var a) ∧ (freeIn var b))"| "freeIn var (Neg a) = freeIn var a"| "freeIn var (ExQ a) = freeIn (var+1) a"| "freeIn var (AllQ a) = freeIn (var+1) a"| "freeIn var (AllN i a) = freeIn (var+i) a"| "freeIn var (ExN i a) = freeIn (var+i) a" fun liftmap :: "(nat ⇒ atom ⇒ atom fm) ⇒ atom fm ⇒ nat ⇒ atom fm" where "liftmap f TrueF var = TrueF"| "liftmap f FalseF var = FalseF"| "liftmap f (Atom a) var = f var a"| "liftmap f (And φ ψ) var = And (liftmap f φ var) (liftmap f ψ var)"| "liftmap f (Or φ ψ) var = Or (liftmap f φ var) (liftmap f ψ var)"| "liftmap f (Neg φ) var = Neg (liftmap f φ var)"| "liftmap f (ExQ φ) var = ExQ (liftmap f φ (var+1))"| "liftmap f (AllQ φ) var = AllQ (liftmap f φ (var+1))"| "liftmap f (AllN i φ) var = AllN i (liftmap f φ (var+i))"| "liftmap f (ExN i φ) var = ExN i (liftmap f φ (var+i))" (* fun greatestFreeVariable :: "atom fm ⇒ nat option" where "greatestFreeVariable F = None" fun is_closed :: "atom fm ⇒ real list ⇒ bool" where "is_closed F xs = (case greatestFreeVariable F of Some x ⇒ (x = length xs) | None ⇒ (0=length xs))" *) fun depth :: "'a fm ⇒ nat"where "depth TrueF = 1"| "depth FalseF = 1"| "depth (Atom _) = 1"| "depth (And φ ψ) = max (depth φ) (depth ψ) + 1"| "depth (Or φ ψ) = max (depth φ) (depth ψ) + 1"| "depth (Neg φ) = depth φ + 1"| "depth (ExQ φ) = depth φ + 1"| "depth (AllQ φ) = depth φ + 1"| "depth (AllN i φ) = depth φ + 1"| "depth (ExN i φ) = depth φ + 1" value "AllQ (And (ExQ (Atom (Eq (Var 1 * Var 2 - (Var 0)^2 * Var 3)))) (Neg (AllQ (Atom (Leq (Const 5 * (Var 1)^2 - Var 0))))) )" fun negation_free :: "atom fm ⇒ bool" where "negation_free TrueF = True" | "negation_free FalseF = True " | "negation_free (Atom a) = True" | "negation_free (And φ⇩1 φ⇩2) = ((negation_free φ⇩1) ∧ (negation_free φ⇩2))" | "negation_free (Or φ⇩1 φ⇩2) = ((negation_free φ⇩1) ∧ (negation_free φ⇩2))" | "negation_free (ExQ φ) = negation_free φ" | "negation_free (AllQ φ) = negation_free φ" | "negation_free (AllN i φ) = negation_free φ" | "negation_free (ExN i φ) = negation_free φ" | "negation_free (Neg _) = False" subsection "Useful Properties" lemma sum_eq : "eval (Atom(Eq p)) L ⟶ eval (Atom(Eq q)) L ⟶ eval (Atom(Eq(p + q))) L" by (simp add: insertion_add) lemma freeIn_list_conj : "(∀f∈set(F). freeIn var f) ⟹ freeIn var (list_conj F)" proof(induct F) case Nil then show ?case by(simp add: list_conj_def) next case (Cons a F) then show ?case by (simp add: PolyAtoms.and_def list_conj_def) qed lemma freeIn_list_disj : assumes "∀f∈set (L::atom fm list). freeIn var f" shows "freeIn var (list_disj L)" using assms proof(induction L) case Nil then show ?case unfolding list_disj_def by auto next case (Cons a L) then show ?case unfolding list_disj_def or_def by simp qed lemma var_not_in_aEval : "freeIn var (Atom φ) ⟹ (∃x. aEval φ (list_update L var x)) = (∀x. aEval φ (list_update L var x))" proof(induction φ) case (Less p) then show ?case apply(auto) using not_contains_insertion by metis next case (Eq p) then show ?case apply(auto) using not_contains_insertion by blast next case (Leq p) then show ?case apply(auto) using not_contains_insertion by metis next case (Neq p) then show ?case apply(auto) using not_contains_insertion by metis qed lemma var_not_in_aEval2 : "freeIn 0 (Atom φ) ⟹ (∃x. aEval φ (x#L)) = (∀x. aEval φ (x#L))" by (metis list_update_code(2) var_not_in_aEval) lemma plugInLinear : assumes lLength : "length L>var" assumes nonzero : "B≠0" assumes hb : "∀v. insertion (nth_default 0 (list_update L var v)) b = B" assumes hc : "∀v. insertion (nth_default 0 (list_update L var v)) c = C" shows "aEval (Eq(b*Var var + c)) (list_update L var (-C/B))" by(simp add: lLength insertion_add insertion_mult nonzero hb hc insertion_var) subsection "Some eval results" lemma doubleExist : "eval (ExN 2 A) L = eval (ExQ (ExQ A)) L" apply(simp) proof(safe) fix l assume h : "length l = 2" "eval A (l @ L)" show "∃x xa. eval A (xa # x # L)" proof(cases l) case Nil then show ?thesis using h by auto next case (Cons a list) then have Cons' : "l = a # list" by auto then show ?thesis proof(cases list) case Nil then show ?thesis using h Cons by auto next case (Cons b list) show ?thesis apply(rule exI[where x=b])apply(rule exI[where x=a]) using h Cons' Cons by auto qed qed next fix x xa assume h : "eval A (xa # x # L)" show "∃l. length l = 2 ∧ eval A (l @ L)" apply(rule exI[where x="[xa,x]"]) using h by simp qed lemma doubleForall : "eval (AllN 2 A) L = eval (AllQ (AllQ A)) L" apply(simp)using doubleExist eval_neg by fastforce lemma unwrapExist : "eval (ExN (j + 1) A) L = eval (ExQ (ExN j A)) L" apply simp apply safe subgoal for l apply(rule exI[where x="nth l j"]) apply(rule exI[where x="take j l"]) apply auto by (metis Cons_nth_drop_Suc append.assoc append_Cons append_eq_append_conv_if append_take_drop_id lessI) subgoal for x l apply(rule exI[where x="l @ [x]"]) by auto done lemma unwrapExist' : "eval (ExN (j + 1) A) L = eval (ExN j (ExQ A)) L" apply simp apply safe subgoal for l apply(rule exI[where x="drop 1 l"]) apply auto apply(rule exI[where x="nth l 0"]) by (metis Cons_nth_drop_Suc append_Cons drop0 zero_less_Suc) subgoal for l x apply(rule exI[where x="x#l"]) by auto done lemma unwrapExist'' : "eval (ExN (i + j) A) L = eval (ExN i(ExN j A)) L" apply simp apply safe subgoal for l apply(rule exI[where x="drop j l"]) apply auto apply(rule exI[where x="take j l"]) apply auto by (metis append.assoc append_take_drop_id) subgoal for l la apply(rule exI[where x="la@l"]) by auto done lemma unwrapForall : "eval (AllN (j + 1) A) L = eval (AllQ (AllN j A)) L" using unwrapExist[of j "neg A" L] eval_neg by fastforce lemma unwrapForall' : "eval (AllN (j + 1) A) L = eval (AllN j (AllQ A)) L" using unwrapExist'[of j "neg A" L] eval_neg by fastforce lemma unwrapForall'' : "eval (AllN (i + j) A) L = eval (AllN i(AllN j A)) L" using unwrapExist''[of i j "neg A" L] eval_neg by fastforce lemma var_not_in_eval : "∀var. ∀L. (freeIn var φ ⟶ ((∃x. eval φ (list_update L var x)) = (∀x. eval φ (list_update L var x))))" proof(induction φ) case TrueF then show ?case by(auto) next case FalseF then show ?case by(auto) next case (Atom x) then show ?case using var_not_in_aEval eval.simps(1) by blast next case (And φ1 φ2) then show ?case by (meson eval.simps(4) freeIn.simps(7)) next case (Or φ1 φ2) then show ?case by fastforce next case (Neg φ) then show ?case by (meson eval.simps(6) freeIn.simps(9)) next case (ExQ φ) fix xa L var x have "(xa::real) # L[var := x] = (xa#L)[var+1:=x]" by simp then show ?case using ExQ by (metis Suc_eq_plus1 eval.simps(7) freeIn.simps(10) list_update_code(3)) next case (AllQ φ) fix xa L var x have "(xa::real) # L[var := x] = (xa#L)[var+1:=x]" by simp then show ?case using AllQ by (metis Suc_eq_plus1 eval.simps(8) freeIn.simps(11) list_update_code(3)) next case (ExN i φ) {fix xa L var x assume "length (xa::real list) = i" have "xa @ L[var := x] = (xa@L)[var+i:=x]" by (simp add: ‹length xa = i› list_update_append) } then show ?case using ExN by (metis eval.simps(10) freeIn.simps(13)) next case (AllN i φ) {fix xa L var x assume "length (xa::real list) = i" have "xa @ L[var := x] = (xa@L)[var+i:=x]" by (simp add: ‹length xa = i› list_update_append) } then show ?case using AllN by (metis eval.simps(9) freeIn.simps(12)) qed lemma var_not_in_eval2 : "∀L. (freeIn 0 φ ⟶ ((∃x. eval φ (x#L)) = (∀x. eval φ (x#L))))" by (metis list_update_code(2) var_not_in_eval) lemma var_not_in_eval3 : assumes "freeIn var φ" assumes "length xs' = var" shows "((∃x. eval φ (xs'@x#L)) = (∀x. eval φ (xs'@x#L)))" using assms by (metis list_update_length var_not_in_eval) lemma eval_list_conj : "eval (list_conj F) L = (∀f∈set(F). eval f L)" proof - { fix f F have h : "eval (foldr and F f) L = (eval f L ∧ (∀f ∈ set F. eval f L))" apply(induct F) apply simp using eval_and by auto } then show ?thesis by(simp add:list_conj_def) qed lemma eval_list_disj : "eval (list_disj F) L = (∃f∈set(F). eval f L)" proof - { fix f F have h : "eval (foldr or F f) L = (eval f L ∨ (∃f ∈ set F. eval f L))" apply(induct F) apply simp using eval_or by auto } then show ?thesis by(simp add:list_disj_def) qed end
section "Debruijn Indicies Formulation" theory Debruijn imports PolyAtoms begin subsection "Lift and Lower Functions" text "these functions are required for debruijn notation the (liftPoly n a p) functions increment each variable greater n in polynomial p by a the (lowerPoly n a p) functions lower each variable greater than n by a so variables n through n+a-1 shouldn't exist " context includes poly_mapping.lifting begin definition "inc_above b i x = (if x < b then x else x + i::nat)" definition "dec_above b i x = (if x ≤ b then x else x - i::nat)" lemma inc_above_dec_above: "x < b ∨ b + i ≤ x ⟹ inc_above b i (dec_above b i x) = x" by (auto simp: inc_above_def dec_above_def) lemma dec_above_inc_above: "dec_above b i (inc_above b i x) = x" by (auto simp: inc_above_def dec_above_def) lemma inc_above_dec_above_iff: "inc_above b i (dec_above b i x) = x ⟷ x < b ∨ b + i ≤ x" by (auto simp: inc_above_def dec_above_def) lemma inj_on_dec_above: "inj_on (dec_above b i) {x. x < b ∨ b + i ≤ x}" by (rule inj_on_inverseI[where g = "inc_above b i"]) (auto simp: inc_above_dec_above) lemma finite_inc_above_ne: "finite {x. f x ≠ c} ⟹ finite {x. f (inc_above b i x) ≠ c}" proof - fix b and f::"nat⇒'a" assume f: "finite {x. f x ≠ c}" moreover have "finite {x. f (x + i) ≠ c}" proof - have "{x. f (x + i) ≠ c} = (+) i -` {x. f x ≠ c}" by (auto simp: ac_simps) also have "finite …" by (rule finite_vimageI) (use f in auto) finally show ?thesis . qed ultimately have "finite ({x. f x ≠ c} ∪ {x. f (x + i) ≠ c})" by auto from _ this show "finite {x. f (inc_above b i x) ≠ c}" by (rule finite_subset) (auto simp: inc_above_def) qed lemma finite_dec_above_ne: "finite {x. f x ≠ c} ⟹ finite {x. f (dec_above b i x) ≠ c}" proof - fix b and f::"nat⇒'a" assume f: "finite {x. f x ≠ c}" moreover have "finite {x. f (x - i) ≠ c}" proof - have "{x. f (x - i) ≠ c} ⊆ {0..i} ∪ ((λx. x - i) -` {x. f x ≠ c} ∩ {i<..})" by auto also have "finite …" apply (rule finite_UnI[OF finite_atLeastAtMost]) by (rule finite_vimage_IntI) (use f in ‹auto simp: inj_on_def›) finally (finite_subset) show ?thesis . qed ultimately have "finite ({x. f x ≠ c} ∪ {x. f (x - i) ≠ c} ∪ {b})" by auto from _ this show "finite {x. f (dec_above b i x) ≠ c}" by (rule finite_subset) (auto simp: dec_above_def) qed lift_definition lowerPowers::"nat ⇒ nat ⇒ (nat ⇒⇩0 'a) ⇒ (nat ⇒⇩0 'a::zero)" is "λb i p x. if x ∈ {b..<b+i} then 0 else p (dec_above b i x)::'a" proof - fix b i::nat and p::"nat ⇒ 'a" assume "finite {x. p x ≠ 0}" then have "finite {x. p (dec_above b i x) ≠ 0}" by (rule finite_dec_above_ne) from _ this show "finite {x. (if x ∈ {b..<b+i} then 0 else p (dec_above b i x)) ≠ 0}" by (rule finite_subset) auto qed lift_definition higherPowers::"nat ⇒ nat ⇒ (nat ⇒⇩0 'a) ⇒ (nat ⇒⇩0 'a::zero)" is "λb i p x. p (inc_above b i x)::'a" by (simp_all add: finite_inc_above_ne) lemma higherPowers_lowerPowers: "higherPowers n i (lowerPowers n i x) = x" by transfer (force simp: dec_above_def inc_above_def antisym_conv2) lemma inj_lowerPowers: "inj (lowerPowers b i)" using higherPowers_lowerPowers by (rule inj_on_inverseI) lemma lowerPowers_higherPowers: "(⋀j. n ≤ j ⟹ j < n + i ⟹ lookup x j = 0) ⟹ lowerPowers n i (higherPowers n i x) = x" by (transfer fixing: n i) (force simp: inc_above_dec_above) lemma inj_on_higherPowers: "inj_on (higherPowers n i) {x. ∀j. n ≤ j ∧ j < n + i ⟶ lookup x j = 0}" using lowerPowers_higherPowers by (rule inj_on_inverseI) auto lemma higherPowers_eq: "lookup (higherPowers b i p) x = lookup p (inc_above b i x)" by (simp_all add: higherPowers.rep_eq) lemma lowerPowers_eq: "lookup (lowerPowers b i p) x = (if b ≤ x ∧ x < b + i then 0 else lookup p (dec_above b i x))" by (auto simp add: lowerPowers.rep_eq) lemma keys_higherPowers: "keys (higherPowers b i m) = dec_above b i ` (keys m ∩ {x. x ∉ {b..<b+i}})" apply safe subgoal for x apply (rule image_eqI[where x="inc_above b i x"]) apply (auto simp: dec_above_inc_above in_keys_iff higherPowers.rep_eq) by (metis add_less_cancel_right inc_above_def leD) subgoal for x by (auto simp: inc_above_dec_above in_keys_iff higherPowers.rep_eq) done context includes fmap.lifting begin lift_definition lowerPowers⇩f::"nat ⇒ nat ⇒ (nat, 'a) fmap ⇒ (nat, 'a::zero) fmap" is "λb i p x. if x ∈ {b..<b+i} then None else p (dec_above b i x)" proof - fix b i::nat and p::"nat ⇒ 'a option" assume "finite (dom p)" then have "finite {x. p x ≠ None}" by (simp add: dom_def) have "dom (λx. p (dec_above b i x)) = {x. p (dec_above b i x) ≠ None}" by auto also have "finite …" by (rule finite_dec_above_ne) fact finally have "finite (dom (λx. p (dec_above b i x)))" . from _ this show "finite (dom (λx. if x ∈ {b..<b+i} then None else p (dec_above b i x)))" by (rule finite_subset) (auto split: if_splits) qed lift_definition higherPowers⇩f::"nat ⇒ nat ⇒ (nat, 'a) fmap ⇒ (nat, 'a) fmap" is "λb i f x. f (inc_above b i x)" proof - fix b i::nat and f::"nat ⇒ 'a option" assume "finite (dom f)" then have "finite {i. f i ≠ None}" by (simp add: dom_def) have "dom (λx. f (inc_above b i x)) = {x. f (inc_above b i x) ≠ None}" by auto also have "finite …" by (rule finite_inc_above_ne) fact finally show "finite (dom (λx. f (inc_above b i x)))" . qed lemma map_of_map_key_inverse_fun_eq: "map_of (map (λ(k, y). (f k, y)) xs) x = map_of xs (g x)" if "⋀x. x ∈ set xs ⟹ g (f (fst x)) = fst x" "f (g x) = x" for f::"'a ⇒ 'b" using that proof (induction xs) case Nil then show ?case by simp next case (Cons a xs) from Cons have IH: "map_of (map (λa. (f (fst a), snd a)) xs) x = map_of xs (g x)" by (auto simp: split_beta') have inv_into: "g (f (fst a)) = fst a" by (rule Cons) simp show ?case using Cons by (auto simp add: split_beta' inv_into IH) qed lemma map_of_filter_key_in: "P x ⟹ map_of (filter (λ(k, v). P k) xs) x = map_of xs x" by (induction xs) (auto simp: ) lemma map_of_eq_NoneI: "x∉fst`set xs ⟹ map_of xs x = None" by (induction xs) (auto simp: ) lemma compute_higherPowers⇩f[code]: "higherPowers⇩f b i (fmap_of_list xs) = fmap_of_list (map (λ(k, v). (if k < b then k else k - i, v)) (filter (λ(k, v). k ∉ {b..<b+i}) xs))" proof - have *: "map_of (map (λ(k, y). (if k < b then k else k - i, y)) (filter (λ(k, v). b ≤ k ⟶ ¬ k < b + i) xs)) x = map_of (filter (λ(k, v). b ≤ k ⟶ ¬ k < b + i) xs) (if x < b then x else x + i)" for x by (rule map_of_map_key_inverse_fun_eq[where g="λk. if k < b then k else k + i" and f = "λk. if k < b then k else k - i"]) auto show ?thesis by (auto simp add: * higherPowers⇩f.rep_eq lowerPowers⇩f.rep_eq fmlookup_of_list fmlookup_default_def inc_above_def map_of_filter_key_in split: option.splits intro!: fmap_ext) qed lemma compute_lowerPowers⇩f[code]: "lowerPowers⇩f b i (fmap_of_list xs) = fmap_of_list (map (λ(k, v). (if k < b then k else k + i, v)) xs)" apply (auto simp add: lowerPowers⇩f.rep_eq fmlookup_of_list fmlookup_default_def dec_above_def map_of_filter_key_in split: option.splits intro!: fmap_ext) subgoal by (rule map_of_eq_NoneI[symmetric]) (auto split: if_splits) subgoal by (subst map_of_map_key_inverse_fun_eq[where g="λk. if k < b then k else k - i"]) auto subgoal by (subst map_of_map_key_inverse_fun_eq[where g="λk. if k < b then k else k - i"]) auto subgoal by (rule map_of_eq_NoneI[symmetric]) (auto split: if_splits) subgoal by (subst map_of_map_key_inverse_fun_eq[where g="λk. if k < b then k else k - i"]) auto done lemma compute_higherPowers[code]: "higherPowers n i (Pm_fmap xs) = Pm_fmap (higherPowers⇩f n i xs)" by (rule poly_mapping_eqI) (auto simp: higherPowers⇩f.rep_eq higherPowers.rep_eq fmlookup_default_def dec_above_def split: option.splits) lemma compute_lowerPowers[code]: "lowerPowers n i (Pm_fmap xs) = Pm_fmap (lowerPowers⇩f n i xs)" by (rule poly_mapping_eqI) (auto simp: lowerPowers⇩f.rep_eq lowerPowers.rep_eq fmlookup_default_def dec_above_def split: option.splits) lemma finite_nonzero_coeff: "finite {x. MPoly_Type.coeff mpoly x ≠ 0}" by transfer auto lift_definition lowerPoly⇩0::"nat ⇒ nat ⇒ ((nat⇒⇩0nat)⇒⇩0'a::zero) ⇒ ((nat⇒⇩0nat)⇒⇩0 'a)" is "λb i (mp::(nat⇒⇩0nat)⇒'a) mon. mp (lowerPowers b i mon)" proof - fix b i and mp::"(nat ⇒⇩0 nat) ⇒ 'a" assume "finite {x. mp x ≠ 0}" have "{x. mp (lowerPowers b i x) ≠ 0} = (lowerPowers b i -` {x. mp x ≠ 0})" (is "?set = ?vimage") by auto also from finite_vimageI[OF ‹finite _› inj_lowerPowers] have "finite ?vimage" . finally show "finite ?set" . qed lemma higherPowers_zero[simp]: "higherPowers b i 0 = 0" by transfer auto lemma keys_lowerPoly⇩0: "keys (lowerPoly⇩0 b i mp) = higherPowers b i ` (keys mp ∩ {x. ∀j∈{b..<b+i}. lookup x j = 0})" apply (auto ) subgoal for x apply (rule image_eqI[where x="lowerPowers b i x"]) apply (auto simp: higherPowers_lowerPowers in_keys_iff lowerPoly⇩0.rep_eq lowerPowers.rep_eq) done subgoal for x apply (auto simp: in_keys_iff lowerPoly⇩0.rep_eq) apply (subst (asm) lowerPowers_higherPowers) apply auto done done lift_definition higherPoly⇩0::"nat ⇒ nat ⇒ ((nat⇒⇩0nat)⇒⇩0'a::zero) ⇒ ((nat⇒⇩0nat)⇒⇩0 'a)" is "λb i (mp::(nat⇒⇩0nat)⇒'a) mon. if (∃j∈{b..<b+i}. lookup mon j > 0) then 0 else mp (higherPowers b i mon)" proof - fix b i and mp::"(nat ⇒⇩0 nat) ⇒ 'a" assume "finite {x. mp x ≠ 0}" have "{x. (if ∃j∈{b..<b + i}. 0 < lookup x j then 0 else mp (higherPowers b i x)) ≠ 0} ⊆ insert 0 (higherPowers b i -` {x. mp x ≠ 0} ∩ {x. ∀j∈{b..<b+i}. lookup x j = 0})" (is "?set ⊆ ?vimage") by auto also from finite_vimage_IntI[OF ‹finite _› inj_on_higherPowers, of b i] have "finite ?vimage" by (auto simp: Ball_def) finally (finite_subset) show "finite ?set" . qed context includes fmap.lifting begin lift_definition lowerPoly⇩f::"nat ⇒ nat ⇒ ((nat⇒⇩0nat), 'a::zero)fmap ⇒ ((nat⇒⇩0nat), 'a)fmap" is "λb i (mp::((nat⇒⇩0nat)⇀'a)) mon::(nat⇒⇩0nat). mp (lowerPowers b i mon)" proof -― ‹TODO: this is exactly the same proof as the one for ‹lowerPoly⇩0›› fix b i and mp::"(nat ⇒⇩0 nat) ⇒ 'a option" assume "finite (dom mp)" also have "dom mp = {x. mp x ≠ None}" by auto finally have "finite {x. mp x ≠ None}" . have "(dom (λmon. mp (lowerPowers b i mon))) = {mon. mp (lowerPowers b i mon) ≠ None}" (is "?set = _") by (auto split: if_splits) also have "… = lowerPowers b i -` {x. mp x ≠ None}" (is "_ = ?vimage") by auto also from finite_vimageI[OF ‹finite {x. mp x ≠ None}› inj_lowerPowers] have "finite ?vimage" . finally show "finite ?set" . qed lift_definition higherPoly⇩f::"nat ⇒ nat ⇒ ((nat⇒⇩0nat), 'a::zero)fmap ⇒ ((nat⇒⇩0nat), 'a)fmap" is "λb i (mp::((nat⇒⇩0nat)⇀'a)) mon::(nat⇒⇩0nat). if (∃j∈{b..<b+i}. lookup mon j > 0) then None else mp (higherPowers b i mon)" proof - fix b i and mp::"(nat ⇒⇩0 nat) ⇀ 'a" assume "finite (dom mp)" have "dom (λx. (if ∃j∈{b..<b + i}. 0 < lookup x j then None else mp (higherPowers b i x))) ⊆ insert 0 (higherPowers b i -` (dom mp) ∩ {x. ∀j∈{b..<b+i}. lookup x j = 0})" (is "?set ⊆ ?vimage") by (auto split: if_splits) also from finite_vimage_IntI[OF ‹finite _› inj_on_higherPowers, of b i] have "finite ?vimage" by (auto simp: Ball_def) finally (finite_subset) show "finite ?set" . qed lemma keys_lowerPowers: "keys (lowerPowers b i m) = inc_above b i ` (keys m)" apply safe subgoal for x apply (rule image_eqI[where x="dec_above b i x"]) apply (auto simp: inc_above_dec_above in_keys_iff lowerPowers.rep_eq) apply (metis inc_above_dec_above not_less) by meson by (metis higherPowers.rep_eq higherPowers_lowerPowers in_keys_iff) lemma keys_higherPoly⇩0: "keys (higherPoly⇩0 b i mp) = lowerPowers b i ` (keys mp)" apply (auto ) subgoal for x apply (rule image_eqI[where x="higherPowers b i x"]) apply (auto simp: lowerPowers_higherPowers in_keys_iff higherPoly⇩0.rep_eq higherPowers.rep_eq) apply (metis atLeastLessThan_iff lowerPowers_higherPowers neq0_conv) by meson subgoal for x apply (auto simp: in_keys_iff higherPoly⇩0.rep_eq) apply (simp add: lowerPowers_eq) by (simp add: higherPowers_lowerPowers) done end lemma inc_above_id[simp]: "n < m ⟹ inc_above m i n = n" by (auto simp: inc_above_def) lemma inc_above_Suc[simp]: "n ≥ m ⟹ inc_above m i n = n + i" by (auto simp: inc_above_def) lemma compute_lowerPoly⇩0[code]: "lowerPoly⇩0 n i (Pm_fmap m) = Pm_fmap (lowerPoly⇩f n i m)" by (auto simp: lowerPoly⇩0.rep_eq fmlookup_default_def lowerPoly⇩f.rep_eq split: option.splits intro!: poly_mapping_eqI) lemma compute_higherPoly⇩0[code]: "higherPoly⇩0 n i (Pm_fmap m) = Pm_fmap (higherPoly⇩f n i m)" by (auto simp: higherPoly⇩0.rep_eq fmlookup_default_def higherPoly⇩f.rep_eq split: option.splits intro!: poly_mapping_eqI) lemma compute_lowerPoly⇩f[code]: "lowerPoly⇩f n i (fmap_of_list xs) = (fmap_of_list (map (λ(mon, c). (higherPowers n i mon, c)) (filter (λ(mon, v). ∀j∈{n..<n+i}. lookup mon j = 0) xs)))" apply (rule sym) apply (rule fmap_ext) unfolding lowerPoly⇩f.rep_eq fmlookup_of_list apply (subst map_of_map_key_inverse_fun_eq[where g="lowerPowers n i"]) subgoal by (auto simp add: lowerPowers_higherPowers) subgoal by (auto simp add: higherPowers_lowerPowers) apply (auto simp: fmlookup_of_list lowerPoly⇩f.rep_eq map_of_eq_None_iff map_of_filter_key_in fmdom'_fmap_of_list higherPowers.rep_eq lowerPowers.rep_eq dec_above_def intro!: fmap_ext) done lemma compute_higherPoly⇩f[code]: "higherPoly⇩f n i (fmap_of_list xs) = fmap_of_list (filter (λ(mon, v). ∀j∈{n..<n+i}. lookup mon j = 0) (map (λ(mon, c). (lowerPowers n i mon, c)) xs))" apply (rule sym) apply (rule fmap_ext) unfolding higherPoly⇩f.rep_eq fmlookup_of_list apply auto subgoal by (rule map_of_eq_NoneI) auto subgoal apply (subst map_of_filter_key_in) apply auto apply (subst map_of_map_key_inverse_fun_eq[where g="higherPowers n i"]) subgoal by (auto simp add: higherPowers_lowerPowers) subgoal by (auto simp add: lowerPowers_higherPowers) apply (auto simp: fmlookup_of_list lowerPoly⇩f.rep_eq map_of_eq_None_iff map_of_filter_key_in fmdom'_fmap_of_list higherPowers.rep_eq lowerPowers.rep_eq dec_above_def intro!: fmap_ext) done done end lift_definition lowerPoly::"nat ⇒ nat ⇒ 'a::zero mpoly ⇒ 'a mpoly" is lowerPoly⇩0 . lift_definition liftPoly::"nat ⇒ nat ⇒ 'a::zero mpoly ⇒ 'a mpoly" is higherPoly⇩0 . lemma coeff_lowerPoly: "MPoly_Type.coeff (lowerPoly b i mp) x = MPoly_Type.coeff mp (lowerPowers b i x)" by (transfer') (simp add: lowerPoly⇩0.rep_eq lowerPowers.rep_eq) lemma coeff_liftPoly: "MPoly_Type.coeff (liftPoly b i mp) x = (if (∃j∈{b..<b+i}. lookup x j > 0) then 0 else MPoly_Type.coeff mp (higherPowers b i x))" by (transfer') (simp add: higherPowers.rep_eq higherPoly⇩0.rep_eq ) lemma monomials_lowerPoly: "monomials (lowerPoly b i mp) = higherPowers b i ` (monomials mp ∩ {x. ∀j∈{b..<b + i}. lookup x j = 0}) " by transfer' (simp add: keys_lowerPoly⇩0) lemma monomials_liftPoly: "monomials (liftPoly b i mp) = lowerPowers b i ` (monomials mp) " using keys_higherPoly⇩0 by (simp add: keys_higherPoly⇩0 liftPoly.rep_eq monomials.rep_eq) value [code] "lowerPoly 1 1 (1 * Var 0 + 2 * Var 2 ^ 2 + 3 * Var 3 ^ 4::int mpoly) = (Var 0 + 2 * Var 1^2 + 3 * Var 2^4::int mpoly)" value [code] "lowerPoly 1 3 (1 * Var 0 + 2 * Var 4 ^ 2 + 3 * Var 5 ^ 4::int mpoly) = (Var 0 + 2 * Var 1^2 + 3 * Var 2^4::int mpoly)" value [code] "liftPoly 1 3 (1 * Var 0 + 2 * Var 4 ^ 2 + 3 * Var 5 ^ 4::int mpoly) = (Var 0 + 2 * Var 7^2 + 3 * Var 8^4::int mpoly)" fun lowerAtom :: "nat ⇒ nat ⇒ atom ⇒ atom" where "lowerAtom d amount (Eq p) = Eq(lowerPoly d amount p)"| "lowerAtom d amount (Less p) = Less(lowerPoly d amount p)"| "lowerAtom d amount (Leq p) = Leq(lowerPoly d amount p)"| "lowerAtom d amount (Neq p) = Neq(lowerPoly d amount p)" lemma lookup_not_in_vars_eq_zero: "x ∈ monomials p ⟹ i ∉ vars p ⟹ lookup x i = 0" by (meson degree_eq_iff varNotIn_degree) lemma nth_dec_above: assumes "length xs = i" "length ys = j" "k ∉ {i..<i+j}" shows "nth_default 0 (xs @ zs) (dec_above i j k) = (nth_default 0 (xs @ ys @ zs)) k" using assms dec_above_def nth_append add.commute by (smt add_diff_cancel_left add_le_cancel_left add_strict_increasing append_Nil2 atLeastLessThan_iff le_add_diff_inverse length_append length_greater_0_conv less_imp_le_nat not_less nth_default_append) lemma insertion_lowerPoly: assumes i_notin: "vars p ∩ {i..<i+j} = {}" and lprfx: "length prfx = i" and lxs: "length xs = j" shows "insertion (nth_default 0 (prfx@L)) (lowerPoly i j p) = insertion (nth_default 0 (prfx@xs@L)) p" (is "?lhs = ?rhs") proof - have *: "monomials p ∩ {x. ∀j∈{i..<i + j}. lookup x j = 0} = monomials p" using assms(1) by (auto intro: lookup_not_in_vars_eq_zero) then have "monomials p ⊆ {x. ∀k. i ≤ k ∧ k < i + j ⟶ lookup x k = 0}" by force have "?lhs = (∑m∈monomials (lowerPoly i j p). MPoly_Type.coeff (lowerPoly i j p) m * (∏k∈keys m. (nth_default 0 (prfx @ L)) k ^ lookup m k))" unfolding insertion_code .. also have "… = (∑m∈monomials p. MPoly_Type.coeff p m * (∏k∈keys m. (nth_default 0 (prfx @ xs @ L) k) ^ lookup m k))" proof (rule sum.reindex_cong) note inj_on_higherPowers[of i j] moreover note ‹monomials p ⊆ _› ultimately show "inj_on (higherPowers i j) (monomials p)" by (rule inj_on_subset) next show "monomials (lowerPoly i j p) = higherPowers i j ` monomials p" unfolding monomials_lowerPoly * .. next fix m assume m: "m ∈ monomials p" from m ‹monomials p ⊆ _› have "keys m ⊆ {x. x ∉ {i..<i + j}}" by auto then have "lookup m k = 0" if "i ≤ k" "k < i + j" for k using that by (auto simp: in_keys_iff) then have "lowerPowers i j (higherPowers i j m) = m" by (rule lowerPowers_higherPowers) then have "MPoly_Type.coeff (lowerPoly i j p) (higherPowers i j m) = MPoly_Type.coeff p m" unfolding coeff_lowerPoly by simp moreover have "(∏k∈keys (higherPowers i j m). (nth_default 0 (prfx @ L)) k ^ lookup (higherPowers i j m) k) = (∏k∈keys m. (nth_default 0 (prfx @ xs @ L)) k ^ lookup m k)" proof (rule prod.reindex_cong) show "keys (higherPowers i j m) = dec_above i j ` keys m" unfolding keys_higherPowers using ‹keys m ⊆ _› by auto next from inj_on_dec_above[of i j] show "inj_on (dec_above i j) (keys m)" by (rule inj_on_subset) (use ‹keys m ⊆ _› in auto) next fix k assume k: "k ∈ keys m" from k ‹keys m ⊆ _› have "k ∉ {i..<i+j}" by auto from k ‹keys m ⊆ _› have "inc_above i j (dec_above i j k) = k" by (subst inc_above_dec_above) auto then have "lookup (higherPowers i j m) (dec_above i j k) = lookup m k" unfolding higherPowers.rep_eq by simp moreover have "nth_default 0 (prfx @ L) (dec_above i j k) = (nth_default 0 (prfx @ xs @ L)) k" apply (rule nth_dec_above) using assms ‹k ∉ _› by auto ultimately show "((nth_default 0 (prfx @ L)) (dec_above i j k)) ^ lookup (higherPowers i j m) (dec_above i j k) = ((nth_default 0 (prfx @ xs @ L)) k) ^ lookup m k" by simp qed ultimately show "MPoly_Type.coeff (lowerPoly i j p) (higherPowers i j m) * (∏k∈keys (higherPowers i j m). (nth_default 0(prfx @ L)) k ^ lookup (higherPowers i j m) k) = MPoly_Type.coeff p m * (∏k∈keys m. (nth_default 0 (prfx @ xs @ L)) k ^ lookup m k)" by simp qed finally show ?thesis unfolding insertion_code . qed lemma insertion_lowerPoly1: assumes i_notin: "i ∉ vars p" and lprfx: "length prfx = i" shows "insertion (nth_default 0 (prfx@x#L)) p = insertion (nth_default 0 (prfx@L)) (lowerPoly i 1 p)" using assms nth_default_def apply simp by (subst insertion_lowerPoly[where xs="[x]"]) auto lemma insertion_lowerPoly01: assumes i_notin: "0 ∉ vars p" shows "insertion (nth_default 0 (x#L)) p = insertion (nth_default 0 L) (lowerPoly 0 1 p)" using insertion_lowerPoly1[OF assms, of Nil x L] by simp lemma aEval_lowerAtom : "(freeIn 0 (Atom A)) ⟹ (aEval A (x#L) = aEval (lowerAtom 0 1 A) L)" by (cases A) (simp_all add:insertion_lowerPoly01) fun map_fm_binders :: "(atom ⇒ nat ⇒ atom) ⇒ atom fm ⇒ nat ⇒ atom fm" where "map_fm_binders f TrueF n = TrueF"| "map_fm_binders f FalseF n = FalseF"| "map_fm_binders f (Atom φ) n = Atom (f φ n)"| "map_fm_binders f (And φ ψ) n = And (map_fm_binders f φ n) (map_fm_binders f ψ n)"| "map_fm_binders f (Or φ ψ) n = Or (map_fm_binders f φ n) (map_fm_binders f ψ n)"| "map_fm_binders f (ExQ φ) n = ExQ(map_fm_binders f φ (n+1))"| "map_fm_binders f (AllQ φ) n = AllQ(map_fm_binders f φ (n+1))"| "map_fm_binders f (AllN i φ) n = AllN i (map_fm_binders f φ (n+i))"| "map_fm_binders f (ExN i φ) n = ExN i (map_fm_binders f φ (n+i))"| "map_fm_binders f (Neg φ) n = Neg(map_fm_binders f φ n)" fun lowerFm :: "nat ⇒ nat ⇒ atom fm ⇒ atom fm" where "lowerFm d amount f = map_fm_binders (λa. λx. lowerAtom (d+x) amount a) f 0" fun delete_nth :: "nat ⇒ real list ⇒ real list" where "delete_nth n xs = take n xs @ drop n xs" lemma eval_lowerFm_helper : assumes "freeIn i F" assumes "length init = i" shows "eval (lowerFm i 1 F) (init @xs) = eval F (init@[x]@xs)" using assms proof(induction F arbitrary : i init) case TrueF then show ?case by simp next case FalseF then show ?case by simp next case (Atom A) then show ?case apply(cases A) by (simp_all add: insertion_lowerPoly1) next case (And F1 F2) then show ?case by auto next case (Or F1 F2) then show ?case by auto next case (Neg F) then show ?case by simp next case (ExQ F) have map: "⋀y. (map_fm_binders (λa x. lowerAtom (i + x) 1 a) F (y + 1)) = (map_fm_binders (λa x. lowerAtom (i + 1 + x) 1 a) F y)" apply(induction F) by(simp_all) show ?case apply simp apply(rule ex_cong1) subgoal for xa using map[of 0] ExQ(1)[of "Suc i" "xa#init"] ExQ(2) ExQ(3) by simp done next case (AllQ F) have map: "⋀y. (map_fm_binders (λa x. lowerAtom (i + x) 1 a) F (y + 1)) = (map_fm_binders (λa x. lowerAtom (i + 1 + x) 1 a) F y)" apply(induction F) by(simp_all) show ?case apply simp apply(rule all_cong1) subgoal for xa using map[of 0] AllQ(1)[of "Suc i" "xa#init"] AllQ(2) AllQ(3) by simp done next case (ExN x1 F) have map: "⋀y. (map_fm_binders (λa x. lowerAtom (i + x) 1 a) F (y + x1)) = (map_fm_binders (λa x. lowerAtom (i + x1 + x) 1 a) F y)" apply(induction F) apply(simp_all add:add.commute add.left_commute) apply (metis add_Suc) apply (metis add_Suc) apply (metis add.assoc) by (metis add.assoc) show ?case apply simp apply(rule ex_cong1) subgoal for l using map[of 0] ExN(1)[of "i+x1" "l@init"] ExN(2) ExN(3) by auto done next case (AllN x1 F) have map: "⋀y. (map_fm_binders (λa x. lowerAtom (i + x) 1 a) F (y + x1)) = (map_fm_binders (λa x. lowerAtom (i + x1 + x) 1 a) F y)" apply(induction F) apply(simp_all add:add.commute add.left_commute) apply (metis add_Suc) apply (metis add_Suc) apply (metis add.assoc) by (metis add.assoc) show ?case apply simp apply(rule all_cong1) subgoal for l using map[of 0] AllN(1)[of "i+x1" "l@init"] AllN(2) AllN(3) by auto done qed lemma eval_lowerFm : assumes h : "freeIn 0 F" shows " ∀xs. (eval (lowerFm 0 1 F) xs = eval (ExQ F) xs)" using eval_lowerFm_helper[OF h] by simp fun liftAtom :: "nat ⇒ nat ⇒ atom ⇒ atom" where "liftAtom d amount (Eq p) = Eq(liftPoly d amount p)"| "liftAtom d amount (Less p) = Less(liftPoly d amount p)"| "liftAtom d amount (Leq p) = Leq(liftPoly d amount p)"| "liftAtom d amount (Neq p) = Neq(liftPoly d amount p)" fun liftFm :: "nat ⇒ nat ⇒ atom fm ⇒ atom fm" where "liftFm d amount f = map_fm_binders (λa. λx. liftAtom (d+x) amount a) f 0" fun insert_into :: "real list ⇒ nat ⇒ real list ⇒ real list" where "insert_into xs n l = take n xs @ l @ drop n xs" lemma higherPoly⇩0_add : "higherPoly⇩0 x y (p + q) = higherPoly⇩0 x y p + higherPoly⇩0 x y q" using poly_mapping_eq_iff[where a = "higherPoly⇩0 x y (p + q)", where b = "higherPoly⇩0 x y p + higherPoly⇩0 x y q"] plus_poly_mapping.rep_eq[where x = "higherPoly⇩0 x y (p + q)", where xa = "higherPoly⇩0 x y p + higherPoly⇩0 x y q"] apply (auto) by (simp add: higherPoly⇩0.rep_eq lookup_add poly_mapping_eqI) lemma liftPoly_add: "liftPoly w z (a + b) = (liftPoly w z a) + (liftPoly w z b)" unfolding liftPoly_def apply (auto) proof - have h1: "mapping_of (a + b) = mapping_of a + mapping_of b" by (simp add: plus_mpoly.rep_eq) have h2: "MPoly (higherPoly⇩0 w z (mapping_of a + mapping_of b)) = MPoly (higherPoly⇩0 w z (mapping_of a)) + MPoly (higherPoly⇩0 w z (mapping_of b))" proof - have h0a: "higherPoly⇩0 w z (mapping_of a + mapping_of b) = (higherPoly⇩0 w z (mapping_of a)) + (higherPoly⇩0 w z (mapping_of b))" using higherPoly⇩0_add[of w z _ _ ] by auto then show ?thesis by (simp add: plus_mpoly.abs_eq) qed show "MPoly (higherPoly⇩0 w z (mapping_of (a + b))) = MPoly (higherPoly⇩0 w z (mapping_of a)) + MPoly (higherPoly⇩0 w z (mapping_of b))" using h1 h2 by auto qed lemma vars_lift_add : "vars(liftPoly a b (p+q)) ⊆ vars(liftPoly a b (p))∪ vars(liftPoly a b (q))" using liftPoly_add[of a b p q] using vars_add[of "liftPoly a b p" "liftPoly a b q"] by auto lemma mapping_of_lift_add : "mapping_of (liftPoly x y (a + b)) = mapping_of (liftPoly x y a) + mapping_of (liftPoly x y b)" unfolding liftPoly.rep_eq plus_mpoly.rep_eq using higherPoly⇩0_add . lemma coeff_lift_add : "MPoly_Type.coeff (liftPoly x y (a + b)) m = MPoly_Type.coeff (liftPoly x y a) m + MPoly_Type.coeff (liftPoly x y b) m" proof- have "MPoly_Type.coeff (liftPoly x y (a + b)) m = MPoly_Type.coeff (liftPoly x y a + liftPoly x y b) m" apply( simp add : mapping_of_lift_add coeff_def ) using lookup_add by (simp add: plus_mpoly.rep_eq) also have "... = MPoly_Type.coeff (liftPoly x y a) m + MPoly_Type.coeff (liftPoly x y b) m" using MPolyExtension.coeff_add[of "liftPoly x y a" "liftPoly x y b" m] . finally show ?thesis by auto qed lemma lift_add : "insertion (f::nat⇒real) (liftPoly 0 z (a + b)) = insertion f (liftPoly 0 z a + liftPoly 0 z b)" using liftPoly_add[of 0 z a b] by simp lemma lower_power_zero : "lowerPowers a b 0 = 0" unfolding lowerPowers_def dec_above_def id_def apply auto unfolding Poly_Mapping.lookup_zero by auto lemma lift_vars_monom : "vars (liftPoly i j ((MPoly_Type.monom m a)::real mpoly)) = (λx. if x≥i then x+j else x) ` vars(MPoly_Type.monom m a)" proof(cases "a=0") case True then show ?thesis by (smt MPolyExtension.monom_zero add.left_neutral add_diff_cancel_right' image_empty liftPoly_add vars_monom_single_cases) next case False have h1: "vars (liftPoly i j (MPoly_Type.monom m a)) = keys (lowerPowers i j m)" unfolding liftPoly_def unfolding keys_lowerPowers keys_higherPoly⇩0 vars_def apply auto apply (smt imageE keys_higherPoly⇩0 keys_lowerPowers lookup_eq_zero_in_keys_contradict lookup_single_not_eq mapping_of_inverse monomials.abs_eq) by (metis False higherPowers.rep_eq higherPowers_lowerPowers image_eqI in_keys_iff keys_higherPoly⇩0 lookup_single_eq mapping_of_inverse monomials.abs_eq) show ?thesis unfolding h1 vars_monom_keys[OF False] keys_lowerPowers inc_above_def by auto qed lemma lift_clear_vars : "vars (liftPoly i j (p::real mpoly)) ∩ {i..<i + j} = {}" proof(induction p rule: mpoly_induct) case (monom m a) then show ?case unfolding lift_vars_monom by auto next case (sum p1 p2 m a) then show ?case using vars_lift_add[of i j p1 p2] by blast qed lemma lift0: "(liftPoly i j 0) = 0" by (simp add: coeff_liftPoly mpoly_eq_iff) lemma lower0: "(lowerPoly i j 0) = 0" by (simp add: coeff_all_0 coeff_lowerPoly) lemma lower_lift_monom : "insertion f (MPoly_Type.monom m a :: real mpoly) = insertion f (lowerPoly i j (liftPoly i j (MPoly_Type.monom m a)))" proof (cases "a=0") case True show ?thesis unfolding True lift0 monom_zero lower0 .. next case False have h1 : "higherPowers i j ` ({lowerPowers i j m} ∩ {x. ∀j∈{i..<i + j}. lookup x j = 0}) = {m}" apply (simp add: lowerPowers.rep_eq higherPowers.rep_eq) using higherPowers_lowerPowers . have higher_lower : "higherPowers i j (lowerPowers i j m) = m" using higherPowers_lowerPowers by blast show ?thesis using False unfolding insertion_code monomials_monom apply auto unfolding monomials_lowerPoly monomials_liftPoly apply auto unfolding More_MPoly_Type.coeff_monom h1 apply auto unfolding coeff_lowerPoly coeff_liftPoly higherPowers_lowerPowers coeff_monom apply(cases "∃ja∈{i..<i + j}. 0 < lookup (lowerPowers i j m) ja") apply auto by (simp add: lowerPowers_eq) qed lemma lower_lift : "insertion f (p::real mpoly) = insertion f (lowerPoly i j (liftPoly i j p))" unfolding insertion_code proof(induction p rule: mpoly_induct) case (monom m a) then show ?case using lower_lift_monom unfolding insertion_code monomials_lowerPoly monomials_liftPoly coeff_lowerPoly coeff_liftPoly by auto next case (sum p1 p2 m a) have h1 : "monomials p1 ∩ monomials p2 = {}" using sum by (metis Int_insert_right_if0 inf_bot_right monomials_monom) have h4 : "monomials (lowerPoly i j (liftPoly i j (p1 + p2))) = monomials (lowerPoly i j (liftPoly i j (p1))) ∪ monomials (lowerPoly i j (liftPoly i j (p2)))" using monomials_lowerPoly monomials_liftPoly monomials_add_disjoint[OF h1] by (simp add: monomials_liftPoly monomials_lowerPoly Int_Un_distrib2 image_Un) have h5 : "MPoly_Type.coeff (lowerPoly i j (liftPoly i j (p1 + p2))) = MPoly_Type.coeff (lowerPoly i j (liftPoly i j (p1))) + MPoly_Type.coeff (lowerPoly i j (liftPoly i j (p2)))" unfolding coeff_lowerPoly coeff_liftPoly MPolyExtension.coeff_add by auto show ?case unfolding MPolyExtension.coeff_add unfolding h4 h5 unfolding monomials_add_disjoint[OF h1] by (smt IntE coeff_eq_zero_iff disjoint_iff_not_equal finite_monomials h1 higherPowers_lowerPowers imageE monomials_liftPoly monomials_lowerPoly plus_fun_apply sum.IH(1) sum.IH(2) sum.cong sum.union_disjoint ) qed lemma lift_insertion : " ∀init. length init = (i::nat) ⟶ (∀I xs. (insertion (nth_default 0 (init @ xs)) (p::real mpoly)) = (insertion ((nth_default 0) (init @ I @ xs)) (liftPoly i (length I) p)))" proof safe fix init I xs assume "i = length (init::real list)" then have i_len : "length init = i" by auto have h: "higherPoly⇩0 i (length (I::real list)) (mapping_of p) ∈ UNIV" by simp have h2 : "vars (liftPoly i (length I) p) ∩ {i..<i + length I} = {}" using lift_clear_vars by auto show "insertion ((nth_default 0) (init @ xs)) p = insertion ((nth_default 0) (init @ I @ xs)) (liftPoly (length init) (length I) p) " using lower_lift insertion_lowerPoly[OF h2 i_len refl, of xs] i_len by auto qed lemma eval_liftFm_helper : assumes "length init = i" assumes "length I = amount" shows "eval F (init @xs) = eval (liftFm i amount F) (init@I@xs)" using assms(1) proof(induction F arbitrary: i init) case (Atom x) then show ?case apply(cases x) apply simp_all using lift_insertion assms Atom.prems by force+ next case (ExQ F) have map: "⋀y. (map_fm_binders (λa x. liftAtom (i + x) (amount) a) F (y + Suc 0)) = (map_fm_binders (λa x. liftAtom (i + 1 + x) amount a) F y)" apply(induction F) by(simp_all) show ?case apply simp apply(rule ex_cong1) subgoal for x using map[of 0] using ExQ(1)[of "x#init" "i+1"] ExQ(2) by simp done next case (AllQ F) have map: "⋀y. (map_fm_binders (λa x. liftAtom (i + x) (amount) a) F (y + Suc 0)) = (map_fm_binders (λa x. liftAtom (i + 1 + x) amount a) F y)" apply(induction F) by(simp_all) show ?case apply simp apply(rule all_cong1) subgoal for x using map[of 0] using AllQ(1)[of "x#init" "i+1"] AllQ(2) by simp done next case (ExN x1 F) have map: "⋀y. (map_fm_binders (λa x. liftAtom (i + x) (amount) a) F (y + x1)) = (map_fm_binders (λa x. liftAtom (i + x1 + x) amount a) F y)" apply(induction F) apply(simp_all add: add.commute add.left_commute) apply (metis add_Suc) apply (metis add_Suc) apply (metis add.assoc) by (metis add.assoc) show ?case apply simp apply(rule ex_cong1) subgoal for l using map[of 0] ExN(1)[of "l@init" "i+x1"] ExN(2) by auto done next case (AllN x1 F) have map: "⋀y. (map_fm_binders (λa x. liftAtom (i + x) (amount) a) F (y + x1)) = (map_fm_binders (λa x. liftAtom (i + x1 + x) amount a) F y)" apply(induction F) apply(simp_all add: add.commute add.left_commute) apply (metis add_Suc) apply (metis add_Suc) apply (metis add.assoc) by (metis add.assoc) show ?case apply simp apply(rule all_cong1) subgoal for l using map[of 0] AllN(1)[of "l@init" "i+x1"] AllN(2) by auto done qed auto lemma eval_liftFm : assumes "length I = amount" assumes "length L ≥ d" shows "eval F L = eval (liftFm d amount F) (insert_into L d I)" proof - define init where "init = take d L" then have "length init = d" using assms by simp then have "(eval F (init @ (drop d L)) = eval (liftFm d amount F) (init @ I @ (drop d L)))" using eval_liftFm_helper[of init d I amount F "(drop d L)"] assms by auto then show ?thesis unfolding insert_into.simps assms init_def by auto qed lemma not_in_lift : "var∉vars(p::real mpoly) ⟹ var+z∉vars(liftPoly 0 z p)" proof(induction p rule: mpoly_induct) case (monom m a) then show ?case using lift_vars_monom[of 0 z m a] by auto next case (sum p1 p2 m a) show ?case using sum using vars_lift_add[of 0 z p1 p2] vars_add[of p1 p2] by (metis (no_types, lifting) Set.basic_monos(7) Un_iff monomials.rep_eq vars_add_monom) qed lemma lift_const : "insertion f (liftPoly 0 z (Const (C::real))) = insertion f (Const C :: real mpoly)" apply(cases "C=0") unfolding insertion_code monomials_Const coeff_Const monomials_liftPoly apply auto unfolding lower_power_zero[of 0 z] lookup_zero power.power_0 comm_monoid_mult_class.prod.neutral_const coeff_liftPoly coeff_Const unfolding higherPowers_def by auto lemma liftPoly_sub: "liftPoly 0 z (a - b) = (liftPoly 0 z a) - (liftPoly 0 z b)" unfolding liftPoly_def apply (auto) proof - have h1: "mapping_of (a - b) = mapping_of a - mapping_of b" by (simp add: minus_mpoly.rep_eq) have h2: "MPoly (higherPoly⇩0 0 z (mapping_of a - mapping_of b)) = MPoly (higherPoly⇩0 0 z (mapping_of a)) - MPoly (higherPoly⇩0 0 z (mapping_of b))" proof - have h0a: "higherPoly⇩0 0 z (mapping_of a - mapping_of b) = (higherPoly⇩0 0 z (mapping_of a)) - (higherPoly⇩0 0 z (mapping_of b))" using poly_mapping_eq_iff[where a = "higherPoly⇩0 0 z (mapping_of a - mapping_of b)", where b = "(higherPoly⇩0 0 z (mapping_of a)) - (higherPoly⇩0 0 z (mapping_of b))"] minus_poly_mapping.rep_eq[where x = "higherPoly⇩0 0 z (mapping_of a - mapping_of b)", where xa = "(higherPoly⇩0 0 z (mapping_of a)) - (higherPoly⇩0 0 z (mapping_of b))"] apply (auto) by (simp add: higherPoly⇩0.rep_eq poly_mapping_eqI minus_poly_mapping.rep_eq) then show ?thesis by (simp add: minus_mpoly.abs_eq) qed show "MPoly (higherPoly⇩0 0 z (mapping_of (a - b))) = MPoly (higherPoly⇩0 0 z (mapping_of a)) - MPoly (higherPoly⇩0 0 z (mapping_of b))" using h1 h2 by auto qed lemma lift_sub : "insertion (f::nat⇒real) (liftPoly 0 z (a - b)) = insertion f (liftPoly 0 z a - liftPoly 0 z b)" using liftPoly_sub[of "z" "a" "b"] by auto lemma lift_minus : assumes "insertion (f::nat ⇒ real) (liftPoly 0 z (c - Const (C::real))) = 0" shows "insertion f (liftPoly 0 z c) = C" proof- have "insertion f (liftPoly 0 z (c - Const C)) = insertion f ((liftPoly 0 z c) - (liftPoly 0 z (Const C)))" by (simp add: lift_sub) have "... = insertion f (liftPoly 0 z c) - (insertion f (liftPoly 0 z (Const C)))" using insertion_sub by auto also have "... = insertion f (liftPoly 0 z c) - C" using lift_const[of f z C] insertion_const by auto then show ?thesis using ‹insertion f (liftPoly 0 z (c - Const C)) = insertion f (liftPoly 0 z c - liftPoly 0 z (Const C))› assms calculation by auto qed end lemma lift00 : "liftPoly 0 0 (a::real mpoly) = a" unfolding liftPoly_def apply auto unfolding higherPoly⇩0_def apply auto unfolding higherPowers_def apply auto by (simp add: mapping_of_inverse) end
subsection "Swapping Indicies" theory Reindex imports Debruijn begin context includes poly_mapping.lifting begin definition "swap i j x = (if x = i then j else if x = j then i else x)" lemma swap_swap : "swap i j (swap i j x) = x" unfolding swap_def by auto lemma finite_swap_ne: "finite {x. f x ≠ c} ⟹ finite {x. f (swap b i x) ≠ c}" proof - assume finset: "finite {x. f x ≠ c}" let ?A = "{x. f x ≠ c}" let ?B = "{x. f (swap b i x) ≠ c}" have finsubset: "finite (?A - {i, b})" using finset by auto have sames: "(?A - {i, b}) = (?B - {i, b})" unfolding swap_def by auto then have "finite (?B - {i, b})" using finsubset by auto then have finBset: "finite ((?B - {i, b}) ∪ {i, b})" by auto then have "?B ⊆ ((?B - {i, b}) ∪ {i, b})" by auto then show ?thesis using finBset by auto qed lift_definition swap0::"nat ⇒ nat ⇒ (nat ⇒⇩0 'a) ⇒ (nat ⇒⇩0 'a::zero)" is "λb i p x. p (swap b i x)::'a" proof - fix b i::nat and p::"nat ⇒ 'a" assume "finite {x. p x ≠ 0}" then have "finite {x. p (swap b i x) ≠ 0}" by (rule finite_swap_ne) from _ this show "finite {x. p (swap b i x) ≠ 0}" by (rule finite_subset) auto qed lemma swap0_swap0: "swap0 n i (swap0 n i x) = x" by transfer (force simp: swap_def) lemma inj_swap: "inj (swap b i)" using swap_swap by (rule inj_on_inverseI) lemma inj_swap0: "inj (swap0 b i)" using swap0_swap0 by (rule inj_on_inverseI) lemma swap0_eq: "lookup (swap0 b i p) x = lookup p (swap b i x)" by (simp_all add: swap0.rep_eq) lemma eq_onp_swap : "eq_onp (λf. finite {x. f x ≠ 0}) (λx. lookup m (swap b i x)) (λx. lookup m (swap b i x))" unfolding eq_onp_def apply simp apply(rule finite_swap_ne) by auto lemma keys_swap: "keys (swap0 b i m) = swap b i ` keys m" apply safe subgoal for x unfolding swap0_def apply simp unfolding keys.abs_eq[OF eq_onp_swap] by (metis (mono_tags, lifting) Reindex.swap_swap image_eqI lookupNotIn mem_Collect_eq) subgoal for x y unfolding swap0_def apply simp unfolding keys.abs_eq[OF eq_onp_swap] by (metis (mono_tags, lifting) Reindex.swap_swap lookup_eq_zero_in_keys_contradict mem_Collect_eq) done context includes fmap.lifting begin lift_definition swap⇩f::"nat ⇒ nat ⇒ (nat, 'a) fmap ⇒ (nat, 'a::zero) fmap" is "λb i p x. p (swap b i x)" proof - fix b i::nat and p::"nat ⇒ 'a option" assume "finite (dom p)" then have "finite {x. p x ≠ None}" by (simp add: dom_def) have "dom (λx. p (swap b i x)) = {x. p (swap b i x) ≠ None}" by auto also have "finite …" by (rule finite_swap_ne) fact finally have "finite (dom (λx. p (swap b i x)))" . from _ this show "finite (dom (λx. p (swap b i x)))" by (rule finite_subset) (auto split: if_splits) qed lemma compute_swap⇩f[code]: "swap⇩f b i (fmap_of_list xs) = fmap_of_list (map (λ(k, v). (swap b i k, v)) xs)" proof - have *: "map_of (map (λ(k, y). (swap b i k, y)) (xs)) x = map_of xs (swap b i x)" for x apply (rule map_of_map_key_inverse_fun_eq) unfolding swap_swap by auto show ?thesis unfolding swap⇩f_def apply simp unfolding fmlookup_of_list unfolding Finite_Map.fmap_of_list.abs_eq using map_of_map_key_inverse_fun_eq[where f="swap b i", where g="swap b i", where xs=xs] unfolding swap_swap apply simp by presburger qed lemma compute_swap[code]: "swap0 n i (Pm_fmap xs) = Pm_fmap (swap⇩f n i xs)" apply(rule poly_mapping_eqI) by (auto simp: swap⇩f.rep_eq swap0.rep_eq fmlookup_default_def swap_def split: option.splits) lift_definition swapPoly⇩0::"nat ⇒ nat ⇒ ((nat⇒⇩0nat)⇒⇩0'a::zero) ⇒ ((nat⇒⇩0nat)⇒⇩0 'a)" is "λb i (mp::(nat⇒⇩0nat)⇒'a) mon. mp (swap0 b i mon)" proof - fix b i and mp::"(nat ⇒⇩0 nat) ⇒ 'a" assume "finite {x. mp x ≠ 0}" have "{x. mp (swap0 b i x) ≠ 0} = (swap0 b i -` {x. mp x ≠ 0})" (is "?set = ?vimage") by auto also from finite_vimageI[OF ‹finite _› inj_swap0] have "finite ?vimage" . finally show "finite ?set" . qed lemma swap_zero[simp]: "swap0 b i 0 = 0" by transfer auto context includes fmap.lifting begin lift_definition swapPoly⇩f::"nat ⇒ nat ⇒ ((nat⇒⇩0nat), 'a::zero)fmap ⇒ ((nat⇒⇩0nat), 'a)fmap" is "λb i (mp::((nat⇒⇩0nat)⇀'a)) mon::(nat⇒⇩0nat). mp (swap0 b i mon)" proof -― ‹TODO: this is exactly the same proof as the one for ‹lowerPoly⇩0›› fix b i and mp::"(nat ⇒⇩0 nat) ⇒ 'a option" assume "finite (dom mp)" also have "dom mp = {x. mp x ≠ None}" by auto finally have "finite {x. mp x ≠ None}" . have "(dom (λmon. mp (swap0 b i mon))) = {mon. mp (swap0 b i mon) ≠ None}" (is "?set = _") by (auto split: if_splits) also have "… = swap0 b i -` {x. mp x ≠ None}" (is "_ = ?vimage") by auto also from finite_vimageI[OF ‹finite {x. mp x ≠ None}› inj_swap0] have "finite ?vimage" . finally show "finite ?set" . qed lemma keys_swap⇩0: "keys (swapPoly⇩0 b i mp) = swap0 b i ` (keys mp)" apply (auto ) subgoal for x apply (rule image_eqI[where x="swap0 b i x"]) by (auto simp: swap0_swap0 in_keys_iff swapPoly⇩0.rep_eq) subgoal for x apply (auto simp: in_keys_iff swapPoly⇩0.rep_eq) by (simp add: swap0_swap0) done end lemma compute_swapPoly⇩0[code]: "swapPoly⇩0 n i (Pm_fmap m) = Pm_fmap (swapPoly⇩f n i m)" by (auto simp: swapPoly⇩0.rep_eq fmlookup_default_def swapPoly⇩f.rep_eq split: option.splits intro!: poly_mapping_eqI) lemma compute_swapPoly⇩f[code]: "swapPoly⇩f n i (fmap_of_list xs) = (fmap_of_list (map (λ(mon, c). (swap0 n i mon, c)) xs))" apply (rule sym) apply (rule fmap_ext) unfolding swapPoly⇩f.rep_eq fmlookup_of_list apply (subst map_of_map_key_inverse_fun_eq[where g="swap0 n i"]) unfolding swap0_swap0 by auto end end lift_definition swap_poly::"nat ⇒ nat ⇒ 'a::zero mpoly ⇒ 'a mpoly" is swapPoly⇩0 . value "swap_poly 0 1 (Var 0 :: real mpoly)" lemma coeff_swap_poly: "MPoly_Type.coeff (swap_poly b i mp) x = MPoly_Type.coeff mp (swap0 b i x)" by (transfer') (simp add: swapPoly⇩0.rep_eq) lemma monomials_swap_poly: "monomials (swap_poly b i mp) = swap0 b i ` (monomials mp) " by transfer' (simp add: keys_swap⇩0) fun swap_atom :: "nat ⇒ nat ⇒ atom ⇒ atom" where "swap_atom a b (Eq p) = Eq (swap_poly a b p)"| "swap_atom a b (Less p) = Less (swap_poly a b p)"| "swap_atom a b (Leq p) = Leq (swap_poly a b p)"| "swap_atom a b (Neq p) = Neq (swap_poly a b p)" fun swap_fm :: "nat ⇒ nat ⇒ atom fm ⇒ atom fm" where "swap_fm a b TrueF = TrueF"| "swap_fm a b FalseF = FalseF"| "swap_fm a b (Atom At) = Atom(swap_atom a b At)"| "swap_fm a b (And A B) = And(swap_fm a b A)(swap_fm a b B)"| "swap_fm a b (Or A B) = Or(swap_fm a b A)(swap_fm a b B)"| "swap_fm a b (Neg A) = Neg(swap_fm a b A)"| "swap_fm a b (ExQ A) = ExQ(swap_fm (a+1) (b+1) A)"| "swap_fm a b (AllQ A) = AllQ(swap_fm (a+1) (b+1) A)"| "swap_fm a b (ExN i A) = ExN i (swap_fm (a+i) (b+i) A)"| "swap_fm a b (AllN i A) = AllN i (swap_fm (a+i) (b+i) A)" fun swap_list :: "nat ⇒ nat ⇒ 'a list ⇒ 'a list"where "swap_list i j l = l[j := nth l i, i := nth l j]" lemma swap_list_cons: "swap_list (Suc a) (Suc b) (x # L) = x # swap_list a b L" by auto lemma inj_on : "inj_on (swap0 a b) (monomials p)" unfolding inj_on_def by (metis swap0_swap0) lemma inj_on' : "inj_on (swap a b) (keys m)" unfolding inj_on_def by (meson Reindex.inj_swap injD) lemma swap_list : assumes "a < length L" assumes "b < length L" shows "nth_default 0 (L[b := L ! a, a := L ! b]) (swap a b xa) = nth_default 0 L xa" using assms unfolding swap_def apply auto apply (simp_all add: nth_default_nth) by (simp add: nth_default_def) lemma swap_poly : assumes "length L > a" assumes "length L > b" shows "insertion (nth_default 0 L) p = insertion (nth_default 0 (swap_list a b L)) (swap_poly a b p)" unfolding insertion_code apply auto unfolding monomials.abs_eq unfolding coeff_swap_poly monomials_swap_poly apply auto unfolding Groups_Big.comm_monoid_add_class.sum.reindex[OF inj_on] apply simp unfolding swap0_swap0 unfolding keys_swap unfolding Groups_Big.comm_monoid_mult_class.prod.reindex[OF inj_on'] apply simp unfolding swap0_eq swap_swap swap_list[OF assms] by auto lemma swap_fm : assumes "length L > a" assumes "length L > b" shows "eval F L = eval (swap_fm a b F) (swap_list a b L)" using assms proof(induction F arbitrary: a b L) case TrueF then show ?case by auto next case FalseF then show ?case by auto next case (Atom At) then show ?case apply(cases At) using swap_poly[OF Atom(1) Atom(2)] by auto next case (And F1 F2) show ?case using And(1)[OF And(3-4)] And(2)[OF And(3-4)] by auto next case (Or F1 F2) then show ?case using Or(1)[OF Or(3-4)] Or(2)[OF Or(3-4)] by auto next case (Neg F) then show ?case using Neg(1)[OF Neg(2-3)] by auto next case (ExQ F) show ?case apply simp apply(rule ex_cong1) subgoal for x using ExQ(1)[of "Suc a" "x#L" "Suc b"] unfolding swap_list_cons using ExQ(2-3) by simp done next case (AllQ F) then show ?case apply simp apply(rule all_cong1) subgoal for x using AllQ(1)[of "Suc a" "x#L" "Suc b"] unfolding swap_list_cons using AllQ(2-3) by simp done next case (ExN i F) show ?case apply simp apply(rule ex_cong1) subgoal for l using ExN(1)[of "a+i" "l@L" "b+i"] by (smt (verit, del_insts) ExN.prems(1) ExN.prems(2) add.commute add_diff_cancel_right' add_less_cancel_left length_append list_update_append not_add_less2 nth_append swap_list.elims) done next case (AllN i F) then show ?case apply simp apply(rule all_cong1) by (smt (z3) add.commute add_diff_cancel_right' le_add2 length_append less_diff_conv2 list_update_append not_add_less2 nth_append) qed lemma "eval (ExQ (ExQ F)) L = eval (ExQ (ExQ (swap_fm 0 1 F))) L" apply simp apply safe subgoal for i j apply(rule exI[where x=j]) apply(rule exI[where x=i]) using swap_fm[of 0 "j # i # L" "Suc 0" F] by simp subgoal for i j apply(rule exI[where x=j]) apply(rule exI[where x=i]) using swap_fm[of 0 "i # j # L" "Suc 0" F] by simp done lemma swap_atom: assumes "length L > a" assumes "length L > b" shows "aEval F L = aEval (swap_atom a b F) (swap_list a b L)" using swap_fm[OF assms, of "Atom F"] by auto end
section "Optimizations" theory Optimizations imports Debruijn begin text "Does negation normal form conversion" fun nnf :: "atom fm ⇒ atom fm" where "nnf TrueF = TrueF" | "nnf FalseF = FalseF " | "nnf (Atom a) = Atom a" | "nnf (And φ⇩1 φ⇩2) = And (nnf φ⇩1) (nnf φ⇩2)" | "nnf (Or φ⇩1 φ⇩2) = Or (nnf φ⇩1) (nnf φ⇩2)" | "nnf (ExQ φ) = ExQ (nnf φ)" | "nnf (AllQ φ) = AllQ (nnf φ)"| "nnf (AllN i φ) = AllN i (nnf φ)"| "nnf (ExN i φ) = ExN i (nnf φ)" | "nnf (Neg TrueF) = FalseF" | "nnf (Neg FalseF) = TrueF" | "nnf (Neg (Neg φ)) = (nnf φ)" | "nnf (Neg (And φ⇩1 φ⇩2)) = (Or (nnf (Neg φ⇩1)) (nnf (Neg φ⇩2)))" | "nnf (Neg (Or φ⇩1 φ⇩2)) = (And (nnf (Neg φ⇩1)) (nnf (Neg φ⇩2)))" | "nnf (Neg (Atom a)) = Atom(aNeg a)" | "nnf (Neg (ExQ φ)) = AllQ (nnf (Neg φ))" | "nnf (Neg (AllQ φ)) = ExQ (nnf (Neg φ))"| "nnf (Neg (AllN i φ)) = ExN i (nnf (Neg φ))"| "nnf (Neg (ExN i φ)) = AllN i (nnf (Neg φ))" subsection "Simplify Constants" fun simp_atom :: "atom ⇒ atom fm" where "simp_atom (Eq p) = (case get_if_const p of None ⇒ Atom(Eq p) | Some(r) ⇒ (if r=0 then TrueF else FalseF))"| "simp_atom (Less p) = (case get_if_const p of None ⇒ Atom(Less p) | Some(r) ⇒ (if r<0 then TrueF else FalseF))"| "simp_atom (Leq p) = (case get_if_const p of None ⇒ Atom(Leq p) | Some(r) ⇒ (if r≤0 then TrueF else FalseF))"| "simp_atom (Neq p) = (case get_if_const p of None ⇒ Atom(Neq p) | Some(r) ⇒ (if r≠0 then TrueF else FalseF))" fun simpfm :: "atom fm ⇒ atom fm" where "simpfm TrueF = TrueF"| "simpfm FalseF = FalseF"| "simpfm (Atom a) = simp_atom a"| "simpfm (And φ ψ) = and (simpfm φ) (simpfm ψ)"| "simpfm (Or φ ψ) = or (simpfm φ) (simpfm ψ)"| "simpfm (ExQ φ) = ExQ (simpfm φ)"| "simpfm (Neg φ) = neg (simpfm φ)"| "simpfm (AllQ φ) = AllQ(simpfm φ)"| "simpfm (AllN i φ) = AllN i (simpfm φ)"| "simpfm (ExN i φ) = ExN i (simpfm φ)" subsection "Group Quantifiers" fun groupQuantifiers :: "atom fm ⇒ atom fm" where "groupQuantifiers TrueF = TrueF"| "groupQuantifiers FalseF = FalseF"| "groupQuantifiers (And A B) = And (groupQuantifiers A) (groupQuantifiers B)"| "groupQuantifiers (Or A B) = Or (groupQuantifiers A) (groupQuantifiers B)"| "groupQuantifiers (Neg A) = Neg (groupQuantifiers A)"| "groupQuantifiers (Atom A) = Atom A"| "groupQuantifiers (ExQ (ExQ A)) = groupQuantifiers (ExN 2 A)"| "groupQuantifiers (ExQ (ExN j A)) = groupQuantifiers (ExN (j+1) A)"| "groupQuantifiers (ExN j (ExQ A)) = groupQuantifiers (ExN (j+1) A)"| "groupQuantifiers (ExN i (ExN j A)) = groupQuantifiers (ExN (i+j) A)"| "groupQuantifiers (ExQ A) = ExQ (groupQuantifiers A)"| "groupQuantifiers (AllQ (AllQ A)) = groupQuantifiers (AllN 2 A)"| "groupQuantifiers (AllQ (AllN j A)) = groupQuantifiers (AllN (j+1) A)"| "groupQuantifiers (AllN j (AllQ A)) = groupQuantifiers (AllN (j+1) A)"| "groupQuantifiers (AllN i (AllN j A)) = groupQuantifiers (AllN (i+j) A)"| "groupQuantifiers (AllQ A) = AllQ (groupQuantifiers A)"| "groupQuantifiers (AllN j A) = AllN j A"| "groupQuantifiers (ExN j A) = ExN j A" subsection "Clear Quantifiers" text "clearQuantifiers F goes through the formula F and removes all quantifiers who's variables are not present in the formula. For example, clearQuantifiers (ExQ(TrueF)) evaluates to TrueF. This preserves the truth value of the formula as shown in the clearQuantifiers\\_eval proof. This is used within the QE overall procedure to eliminate quantifiers in the cases where QE was successful." fun depth' :: "'a fm ⇒ nat"where "depth' TrueF = 1"| "depth' FalseF = 1"| "depth' (Atom _) = 1"| "depth' (And φ ψ) = max (depth' φ) (depth' ψ) + 1"| "depth' (Or φ ψ) = max (depth' φ) (depth' ψ) + 1"| "depth' (Neg φ) = depth' φ + 1"| "depth' (ExQ φ) = depth' φ + 1"| "depth' (AllQ φ) = depth' φ + 1"| "depth' (AllN i φ) = depth' φ + i * 2 + 1"| "depth' (ExN i φ) = depth' φ + i * 2 + 1" function clearQuantifiers :: "atom fm ⇒ atom fm" where "clearQuantifiers TrueF = TrueF"| "clearQuantifiers FalseF = FalseF"| "clearQuantifiers (Atom a) = simp_atom a"| "clearQuantifiers (And φ ψ) = and (clearQuantifiers φ) (clearQuantifiers ψ)"| "clearQuantifiers (Or φ ψ) = or (clearQuantifiers φ) (clearQuantifiers ψ)"| "clearQuantifiers (Neg φ) = neg (clearQuantifiers φ)"| "clearQuantifiers (ExQ φ) = (let φ' = clearQuantifiers φ in (if freeIn 0 φ' then lowerFm 0 1 φ' else ExQ φ'))"| "clearQuantifiers (AllQ φ) = (let φ' = clearQuantifiers φ in (if freeIn 0 φ' then lowerFm 0 1 φ' else AllQ φ'))"| "clearQuantifiers (ExN 0 φ) = clearQuantifiers φ"| "clearQuantifiers (ExN (Suc i) φ) = clearQuantifiers (ExN i (ExQ φ))"| "clearQuantifiers (AllN 0 φ) = clearQuantifiers φ"| "clearQuantifiers (AllN (Suc i) φ) = clearQuantifiers (AllN i (AllQ φ))" by pat_completeness auto termination apply(relation "measures [λA. depth' A]") by auto subsection "Push Forall" fun push_forall :: "atom fm ⇒ atom fm" where "push_forall TrueF = TrueF"| "push_forall FalseF = FalseF"| "push_forall (Atom a) = simp_atom a"| "push_forall (And φ ψ) = and (push_forall φ) (push_forall ψ)"| "push_forall (Or φ ψ) = or (push_forall φ) (push_forall ψ)"| "push_forall (ExQ φ) = ExQ (push_forall φ)"| "push_forall (ExN i φ) = ExN i (push_forall φ)"| "push_forall (Neg φ) = neg (push_forall φ)"| "push_forall (AllQ TrueF) = TrueF"| "push_forall (AllQ FalseF) = FalseF"| "push_forall (AllQ (Atom a)) = (if freeIn 0 (Atom a) then Atom(lowerAtom 0 1 a) else AllQ (Atom a))"| "push_forall (AllQ (And φ ψ)) = and (push_forall (AllQ φ)) (push_forall (AllQ ψ))"| "push_forall (AllQ (Or φ ψ)) = ( if freeIn 0 φ then( if freeIn 0 ψ then or (lowerFm 0 1 φ) (lowerFm 0 1 ψ) else or (lowerFm 0 1 φ) (AllQ ψ)) else ( if freeIn 0 ψ then or (AllQ φ) (lowerFm 0 1 ψ) else AllQ (or φ ψ)) )"| "push_forall (AllQ φ) = (if freeIn 0 φ then lowerFm 0 1 φ else AllQ φ)"| "push_forall (AllN i φ) = AllN i (push_forall φ)" (* TODO, several bugs in this *) subsection "Unpower" fun to_list :: "nat ⇒ real mpoly ⇒ (real mpoly * nat) list" where "to_list v p = [(isolate_variable_sparse p v x, x). x ← [0..<(MPoly_Type.degree p v)+1]]" fun chop :: "(real mpoly * nat) list ⇒ (real mpoly * nat) list"where "chop [] = []"| "chop ((p,i)#L) = (if p=0 then chop L else (p,i)#L)" fun decreasePower :: "nat ⇒ real mpoly ⇒ real mpoly * nat"where "decreasePower v p = (case chop (to_list v p) of [] ⇒ (p,0) | ((p,i)#L) ⇒ (sum_list [term * (Var v) ^ (x-i). (term,x)←((p,i)#L)],i))" fun unpower :: "nat ⇒ atom fm ⇒ atom fm" where "unpower v (Atom (Eq p)) = (case decreasePower v p of (_,0) ⇒ Atom(Eq p)| (p,_) ⇒ Or(Atom (Eq p))(Atom (Eq (Var v))) )"| "unpower v (Atom (Neq p)) = (case decreasePower v p of (_,0) ⇒ Atom(Neq p)| (p,_) ⇒ And(Atom (Neq p))(Atom (Neq (Var v))) )"| "unpower v (Atom (Less p)) = (case decreasePower v p of (_,0) ⇒ Atom(Less p)| (p,n) ⇒ if n mod 2 = 0 then And(Atom (Less p))(Atom(Neq (Var v))) else Or (And (Atom (Less ( p))) (Atom (Less (-Var v)))) (And (Atom (Less (-p))) (Atom (Less (Var v)))) )"| "unpower v (Atom (Leq p)) = (case decreasePower v p of (_,0) ⇒ Atom(Leq p)| (p,n) ⇒ if n mod 2 = 0 then Or (Atom (Leq p)) (Atom (Eq (Var v))) else Or (Atom (Eq p)) (Or (And (Atom (Less ( p))) (Atom (Leq (-Var v)))) (And (Atom (Less (-p))) (Atom (Leq (Var v))))) )"| "unpower v (And a b) = And (unpower v a) (unpower v b)"| "unpower v (Or a b) = Or (unpower v a) (unpower v b)"| "unpower v (Neg a) = Neg (unpower v a)"| "unpower v (TrueF) = TrueF"| "unpower v (FalseF) = FalseF"| "unpower v (AllQ F) = AllQ(unpower (v+1) F)"| "unpower v (ExQ F) = ExQ (unpower (v+1) F)"| "unpower v (AllN x F) = AllN x (unpower (v+x) F)"| "unpower v (ExN x F) = ExN x (unpower (v+x) F)" end
subsection "Optimization Proofs" theory OptimizationProofs imports Optimizations begin lemma neg_nnf : "∀Γ. (¬ eval (nnf (Neg φ)) Γ) = eval (nnf φ) Γ" apply(induction φ) apply(simp_all) using aNeg_aEval apply blast using aNeg_aEval by blast theorem eval_nnf : "∀Γ. eval φ Γ = eval (nnf φ) Γ" apply(induction φ)apply(simp_all) using neg_nnf by blast theorem negation_free_nnf : "negation_free (nnf φ)" proof(induction "depth φ" arbitrary : φ rule: nat_less_induct ) case 1 then show ?case proof(induction φ) case (And φ1 φ2) then show ?case apply simp by (metis less_Suc_eq_le max.cobounded1 max.cobounded2) next case (Or φ1 φ2) then show ?case apply simp by (metis less_Suc_eq_le max.cobounded1 max.cobounded2) next case (Neg φ) then show ?case proof (induction φ) case (And φ1 φ2) then show ?case apply simp by (metis less_Suc_eq max_less_iff_conj not_less_eq) next case (Or φ1 φ2) then show ?case apply simp by (metis less_Suc_eq max_less_iff_conj not_less_eq) next case (Neg φ) then show ?case by (metis Suc_eq_plus1 add_lessD1 depth.simps(6) lessI nnf.simps(12)) qed auto qed auto qed lemma groupQuantifiers_eval : "eval F L = eval (groupQuantifiers F) L" apply(induction F arbitrary: L rule:groupQuantifiers.induct) unfolding doubleExist unwrapExist unwrapExist' unwrapExist'' doubleForall unwrapForall unwrapForall' unwrapForall'' apply (auto) using doubleExist doubleExist unwrapExist unwrapExist' unwrapExist'' doubleForall unwrapForall unwrapForall' unwrapForall'' apply auto by metis+ theorem simp_atom_eval : "aEval a xs = eval (simp_atom a) xs" proof(cases a) case (Less p) then show ?thesis by(cases "get_if_const p")(simp_all add:get_if_const_insertion) next case (Eq p) then show ?thesis by(cases "get_if_const p")(simp_all add:get_if_const_insertion) next case (Leq p) then show ?thesis by(cases "get_if_const p")(simp_all add:get_if_const_insertion) next case (Neq p) then show ?thesis by(cases "get_if_const p")(simp_all add:get_if_const_insertion) qed lemma simpfm_eval : "∀L. eval φ L = eval (simpfm φ) L" apply(induction φ) apply(simp_all add: simp_atom_eval eval_and eval_or) using eval_neg by blast lemma exQ_clearQuantifiers: assumes ExQ : "⋀xs. eval (clearQuantifiers φ) xs = eval φ xs" shows "eval (clearQuantifiers (ExQ φ)) xs = eval (ExQ φ) xs" proof- define φ' where "φ' = clearQuantifiers φ" have h : "freeIn 0 φ' ⟹ (eval (lowerFm 0 1 φ') xs = eval (ExQ φ') xs)" using eval_lowerFm by simp have "eval (clearQuantifiers (ExQ φ)) xs = eval (if freeIn 0 φ' then lowerFm 0 1 φ' else ExQ φ') xs" using φ'_def by simp also have "... = eval (ExQ φ) xs" apply(cases "freeIn 0 φ'") using h ExQ φ'_def by(simp_all) finally show ?thesis by simp qed lemma allQ_clearQuantifiers : assumes AllQ : "⋀xs. eval (clearQuantifiers φ) xs = eval φ xs" shows "eval (clearQuantifiers (AllQ φ)) xs = eval (AllQ φ) xs" proof- define φ' where "φ' = clearQuantifiers φ" have "freeIn 0 φ' ⟹ (eval (ExQ φ') xs) = eval (AllQ φ') xs" by (simp add: var_not_in_eval2) then have h : "freeIn 0 φ' ⟹ (eval (lowerFm 0 1 φ') xs = eval (AllQ φ') xs)" using eval_lowerFm by simp have "eval (clearQuantifiers (AllQ φ)) xs = eval (if freeIn 0 φ' then lowerFm 0 1 φ' else AllQ φ') xs" using φ'_def by simp also have "... = eval (AllQ φ) xs" apply(cases "freeIn 0 φ'") using h AllQ φ'_def by(simp_all) finally show ?thesis by simp qed lemma clearQuantifiers_eval : "eval (clearQuantifiers φ) xs = eval φ xs" proof(induction φ arbitrary : xs) case (Atom x) then show ?case using simp_atom_eval by simp next case (And φ1 φ2) then show ?case using eval_and by simp next case (Or φ1 φ2) then show ?case using eval_or by simp next case (Neg φ) then show ?case using eval_neg by auto next case (ExQ φ) then show ?case using exQ_clearQuantifiers by simp next case (AllQ φ) then show ?case using allQ_clearQuantifiers by simp next case (ExN x1 φ) then show ?case proof(induction x1 arbitrary:φ) case 0 then show ?case by auto next case (Suc x1) show ?case using Suc(1)[of "ExQ φ", OF exQ_clearQuantifiers[OF Suc(2)]] apply simp using Suc_eq_plus1 ‹eval (clearQuantifiers (ExN x1 (ExQ φ))) xs = eval (ExN x1 (ExQ φ)) xs› eval.simps(10) unwrapExist' by presburger qed next case (AllN x1 φ) then show ?case proof(induction x1 arbitrary:φ) case 0 then show ?case by auto next case (Suc x1) show ?case using Suc(1)[of "AllQ φ", OF allQ_clearQuantifiers[OF Suc(2)]] apply simp using unwrapForall' by force qed qed auto lemma push_forall_eval_AllQ : "∀xs. eval (AllQ φ) xs = eval (push_forall (AllQ φ)) xs" proof(induction φ) case TrueF then show ?case by simp next case FalseF then show ?case by simp next case (Atom x) then show ?case using aEval_lowerAtom eval.simps(1) eval.simps(8) push_forall.simps(11) by presburger next case (And φ1 φ2) {fix xs have "eval (AllQ (And φ1 φ2)) xs = (∀x. eval φ1 (x#xs) ∧ eval φ2 (x#xs))" by simp also have "... = ((∀x. eval φ1 (x#xs)) ∧ (∀x. eval φ2 (x#xs)))" by blast also have "... = eval (push_forall (AllQ (And φ1 φ2))) xs" using And eval_and by(simp) finally have "eval (AllQ (And φ1 φ2)) xs = eval (push_forall (AllQ (And φ1 φ2))) xs" by simp } then show ?case by simp next case (Or φ1 φ2) then show ?case proof(cases "freeIn 0 φ1") case True then have h : "freeIn 0 φ1" by simp then show ?thesis proof(cases "freeIn 0 φ2") case True {fix xs have "∃x. eval φ1 (x # xs) = eval (lowerFm 0 1 φ1) xs" using eval_lowerFm h eval.simps(7) by blast then have h1 : "∀x. eval φ1 (x # xs) = eval (lowerFm 0 1 φ1) xs" using h var_not_in_eval2 by blast have "∃x. eval φ2 (x # xs) = eval (lowerFm 0 1 φ2) xs" using eval_lowerFm True eval.simps(7) by blast then have h2 : "∀x. eval φ2 (x # xs) = eval (lowerFm 0 1 φ2) xs" using True var_not_in_eval2 by blast have "eval (AllQ (Or φ1 φ2)) xs = eval (push_forall (AllQ (Or φ1 φ2))) xs" by(simp add:h h1 h2 True eval_or) } then show ?thesis by simp next case False {fix xs have "∃x. eval φ1 (x # xs) = eval (lowerFm 0 1 φ1) xs" using eval_lowerFm h eval.simps(7) by blast then have "∀x. eval φ1 (x # xs) = eval (lowerFm 0 1 φ1) xs" using True var_not_in_eval2 by blast then have "eval (AllQ (Or φ1 φ2)) xs = eval (push_forall (AllQ (Or φ1 φ2))) xs" by(simp add:h False eval_or) } then show ?thesis by simp qed next case False then have h : "¬freeIn 0 φ1" by simp then show ?thesis proof(cases "freeIn 0 φ2") case True {fix xs have "∃x. eval φ2 (x # xs) = eval (lowerFm 0 1 φ2) xs" using eval_lowerFm True eval.simps(7) by blast then have "∀x. eval φ2 (x # xs) = eval (lowerFm 0 1 φ2) xs" using True var_not_in_eval2 by blast then have "eval (AllQ (Or φ1 φ2)) xs = eval (push_forall (AllQ (Or φ1 φ2))) xs" by(simp add:h True eval_or) } then show ?thesis by simp next case False then show ?thesis by(simp add:h False eval_or) qed qed next case (Neg φ) {fix xs have "freeIn 0 (Neg φ) ⟹ (eval (ExQ (Neg φ)) xs) = eval (AllQ (Neg φ)) xs" using var_not_in_eval2 eval.simps(7) eval.simps(8) by blast then have h : "freeIn 0 (Neg φ) ⟹ (eval (lowerFm 0 1 (Neg φ)) xs = eval (AllQ (Neg φ)) xs)" using eval_lowerFm by blast have "eval (push_forall (AllQ (Neg φ))) xs = eval (if freeIn 0 (Neg φ) then lowerFm 0 1 (Neg φ) else AllQ (Neg φ)) xs" by simp also have "... = eval (AllQ (Neg φ)) xs" apply(cases "freeIn 0 (Neg φ)") using h by(simp_all) finally have "eval (push_forall (AllQ (Neg φ))) xs = eval (AllQ (Neg φ)) xs" by simp } then show ?case by simp next case (ExQ φ) {fix xs have "freeIn 0 (ExQ φ) ⟹ (eval (ExQ (ExQ φ)) xs) = eval (AllQ (ExQ φ)) xs" using var_not_in_eval2 eval.simps(7) eval.simps(8) by blast then have h : "freeIn 0 (ExQ φ) ⟹ (eval (lowerFm 0 1 (ExQ φ)) xs = eval (AllQ (ExQ φ)) xs)" using eval_lowerFm by blast have "eval (push_forall (AllQ (ExQ φ))) xs = eval (if freeIn 0 (ExQ φ) then lowerFm 0 1 (ExQ φ) else AllQ (ExQ φ)) xs" by simp also have "... = eval (AllQ (ExQ φ)) xs" apply(cases "freeIn 0 (ExQ φ)") using h by(simp_all) finally have "eval (push_forall (AllQ (ExQ φ))) xs = eval (AllQ (ExQ φ)) xs" by simp } then show ?case by simp next case (AllQ φ) {fix xs have "freeIn 0 (AllQ φ) ⟹ (eval (ExQ (AllQ φ)) xs) = eval (AllQ (AllQ φ)) xs" using var_not_in_eval2 eval.simps(7) eval.simps(8) by blast then have h : "freeIn 0 (AllQ φ) ⟹ (eval (lowerFm 0 1 (AllQ φ)) xs = eval (AllQ (AllQ φ)) xs)" using eval_lowerFm by blast have "eval (push_forall (AllQ (AllQ φ))) xs = eval (if freeIn 0 (AllQ φ) then lowerFm 0 1 (AllQ φ) else AllQ (AllQ φ)) xs" by simp also have "... = eval (AllQ (AllQ φ)) xs" apply(cases "freeIn 0 (AllQ φ)") using h AllQ by(simp_all) finally have "eval (push_forall (AllQ (AllQ φ))) xs = eval (AllQ (AllQ φ)) xs" by simp } then show ?case by simp next case (ExN x1 φ) then show ?case using eval.simps(7) eval.simps(8) eval_lowerFm push_forall.simps(17) var_not_in_eval2 by presburger next case (AllN x1 φ) then show ?case using eval.simps(7) eval.simps(8) eval_lowerFm push_forall.simps(18) var_not_in_eval2 by presburger qed lemma push_forall_eval : "∀xs. eval φ xs = eval (push_forall φ) xs" proof(induction φ) case (Atom x) then show ?case using simp_atom_eval by simp next case (And φ1 φ2) then show ?case using eval_and by auto next case (Or φ1 φ2) then show ?case using eval_or by auto next case (Neg φ) then show ?case using eval_neg by auto next case (AllQ φ) then show ?case using push_forall_eval_AllQ by blast next case (ExN x1 φ) then show ?case using eval.simps(10) push_forall.simps(7) by presburger qed auto lemma map_fm_binders_negation_free : assumes "negation_free φ" shows "negation_free (map_fm_binders f φ n)" using assms apply(induction φ arbitrary : n) by auto lemma negation_free_and : assumes "negation_free φ" assumes "negation_free ψ" shows "negation_free (and φ ψ)" using assms unfolding and_def by simp lemma negation_free_or : assumes "negation_free φ" assumes "negation_free ψ" shows "negation_free (or φ ψ)" using assms unfolding or_def by simp lemma push_forall_negation_free_all : assumes "negation_free φ" shows "negation_free (push_forall (AllQ φ))" using assms proof(induction φ) case (And φ1 φ2) show ?case apply auto apply(rule negation_free_and) using And by auto next case (Or φ1 φ2) show ?case apply auto apply(rule negation_free_or) using Or map_fm_binders_negation_free negation_free_or by auto next case (ExQ φ) then show ?case using map_fm_binders_negation_free by auto next case (AllQ φ) then show ?case using map_fm_binders_negation_free by auto next case (ExN x1 φ) then show ?case using map_fm_binders_negation_free by auto next case (AllN x1 φ) then show ?case using map_fm_binders_negation_free by auto qed auto lemma push_forall_negation_free : assumes "negation_free φ" shows "negation_free(push_forall φ)" using assms proof(induction φ) case (Atom A) then show ?case apply(cases A) by auto next case (And φ1 φ2) then show ?case by (auto simp add: and_def) next case (Or φ1 φ2) then show ?case by (auto simp add: or_def) next case (AllQ φ) then show ?case using push_forall_negation_free_all by auto qed auto lemma to_list_insertion: "insertion f p = sum_list [insertion f term * (f v) ^ i. (term,i)←(to_list v p)]" proof- have h1 : "insertion f p = insertion f (∑i≤MPoly_Type.degree p v. isolate_variable_sparse p v i * Var v ^ i)" using sum_over_zero by auto have h2 : "insertion f (Var v) = f v" by (auto simp: monomials_Var coeff_Var insertion_code) define d where "d = MPoly_Type.degree p v" define g where "g = (λx. insertion f (isolate_variable_sparse p v x) * f v ^ x)" have h3 : "insertion f (isolate_variable_sparse p v d) * f v ^ d = g d" using g_def by auto show ?thesis unfolding h1 insertion_sum' insertion_mult insertion_pow h2 apply auto unfolding d_def[symmetric] g_def[symmetric] h3 proof(induction d) case 0 then show ?case by auto next case (Suc d) show ?case apply (auto simp add: Suc ) unfolding g_def by auto qed qed lemma to_list_p: "p = sum_list [term * (Var v) ^ i. (term,i)←(to_list v p)]" proof- define d where "d = MPoly_Type.degree p v" have "(∑i≤MPoly_Type.degree p v. isolate_variable_sparse p v i * Var v ^ i) = (∑(term, i)←to_list v p. term * Var v ^ i)" unfolding to_list.simps d_def[symmetric] apply(induction d) by auto then show ?thesis using sum_over_zero[of p v] by auto qed fun chophelper :: "(real mpoly * nat) list ⇒ (real mpoly * nat) list ⇒ (real mpoly * nat) list * (real mpoly * nat) list" where "chophelper [] L = (L,[])"| "chophelper ((p,i)#L) R = (if p=0 then chophelper L (R @ [(p,i)]) else (R,(p,i)#L))" lemma preserve : assumes "(a,b)=chophelper L L'" shows "a@b=L'@L" using assms proof(induction L arbitrary : a b L') case Nil then show ?case using assms by auto next case (Cons A L) then show ?case proof(cases A) case (Pair p i) show ?thesis using Cons unfolding Pair apply(cases "p=0") by auto qed qed lemma compare : assumes "(a,b)=chophelper L L'" shows "chop L = b" using assms proof(induction L arbitrary : a b L') case Nil then show ?case by auto next case (Cons A L) then show ?case proof(cases A) case (Pair p i) show ?thesis using Cons unfolding Pair apply(cases "p=0") by auto qed qed lemma allzero: assumes "∀(p,i)∈set(L'). p=0" assumes "(a,b)=chophelper L L'" shows "∀(p,i)∈set(a). p=0" using assms proof(induction L arbitrary : a b L') case Nil then show ?case by auto next case (Cons t L) then show ?case proof(cases t) case (Pair p i) show ?thesis proof(cases "p=0") case True have h1: "∀x∈set (L' @ [(0, i)]). case x of (p, i) ⇒ p = 0" using Cons(2) by auto show ?thesis using Cons(1)[OF h1] Cons(3) True unfolding Pair by auto next case False then show ?thesis using Cons unfolding Pair by auto qed qed qed lemma separate: assumes "(a,b)=chophelper (to_list v p) []" shows "insertion f p = sum_list [insertion f term * (f v) ^ i. (term,i)←a] + sum_list [insertion f term * (f v) ^ i. (term,i)←b]" using to_list_insertion[of f p v] preserve[OF assms, symmetric] unfolding List.append.left_neutral by (simp del: to_list.simps) lemma chopped : assumes "(a,b)=chophelper (to_list v p) []" shows "insertion f p = sum_list [insertion f term * (f v) ^ i. (term,i)←b]" proof- have h1 : "∀(p, i)∈set []. p = 0" by auto have "(∑(term, i)←a. insertion f term * f v ^ i) = 0" using allzero[OF h1 assms] proof(induction a) case Nil then show ?case by auto next case (Cons a1 a2) then show ?case apply(cases a1) by simp qed then show ?thesis using separate[OF assms, of f] by auto qed lemma insertion_chop : shows "insertion f p = sum_list [insertion f term * (f v) ^ i. (term,i)←(chop (to_list v p))]" proof(cases "chophelper (to_list v p) []") case (Pair a b) show ?thesis using chopped[OF Pair[symmetric], of f] unfolding compare[OF Pair[symmetric], symmetric] . qed lemma sorted : "sorted_wrt (λ(_,i).λ(_,i'). i<i') (to_list v p)" proof - define d where "d = MPoly_Type.degree p v" show ?thesis unfolding to_list.simps d_def[symmetric] proof(induction d) case 0 then show ?case by auto next case (Suc d) have h : "(map (λx. (isolate_variable_sparse p v x, x)) [0..<Suc d + 1]) = (map (λx. (isolate_variable_sparse p v x, x)) [0..<Suc d]) @ [(isolate_variable_sparse p v (Suc d), (Suc d))]" by auto show ?case unfolding sorted_wrt_append h using Suc by auto qed qed lemma sublist : "sublist (chop L) L" proof(induction L) case Nil then show ?case by auto next case (Cons a L) then show ?case proof(cases a) case (Pair a b) show ?thesis using Cons unfolding Pair apply auto by (simp add: sublist_Cons_right) qed qed lemma move_exp : assumes "(p',i)#L = (chop (to_list v p))" shows "insertion f p = sum_list [insertion f term * (f v) ^ (d-i). (term,d)←(chop (to_list v p))] * (f v)^i" proof- have h : "sorted_wrt (λ(_, i) (_, y). i < y) (chop (to_list v p))" proof- define L where "L = to_list v p" show ?thesis using sublist[of "to_list v p"] sorted[of v p] unfolding L_def[symmetric] by (metis sorted_wrt_append sublist_def) qed then have "∀(term,d)∈set(chop (to_list v p)). d≥i" unfolding assms[symmetric] by fastforce then have simp : "∀(term,d)∈set(chop(to_list v p)). f v ^ (d - i) * f v ^ i = f v ^ d" unfolding HOL.no_atp(118) by(auto simp del: to_list.simps) have "insertion f p = sum_list [insertion f term * (f v) ^ i. (term,i)←(chop (to_list v p))]" using insertion_chop[of f p v] . also have "...= (∑(term, d)←chop (to_list v p). insertion f term * f v ^ (d-i) * f v ^ i)" using simp by (smt Pair_inject case_prodE map_eq_conv mult.assoc split_cong) also have "... = (∑(term, d)←chop (to_list v p). insertion f term * f v ^ (d - i)) * f v ^ i" proof- define d where "d = chop(to_list v p)" define a where "a = f v ^ i" define b where "b = (λ(term, d). insertion f term * f v ^ (d - i))" have h : "(∑(term, d)←d. insertion f term * f v ^ (d - i) * a) = (∑(term, d)←d. b (term,d) * a)" using b_def by auto show ?thesis unfolding d_def[symmetric] a_def[symmetric] b_def[symmetric] h apply(induction d) apply simp apply auto by (simp add: ring_class.ring_distribs(2)) qed finally show ?thesis by auto qed lemma insert_Var_Zero : "insertion f (Var v) = f v" unfolding insertion_code monomials_Var apply auto unfolding coeff_Var by simp lemma decreasePower_insertion : assumes "decreasePower v p = (p',i)" shows "insertion f p = insertion f p'* (f v)^i" proof(cases "chop (to_list v p)") case Nil then show ?thesis using assms by auto next case (Cons a list) then show ?thesis proof(cases a) case (Pair coef i') have i'_def : "i'=i" using Cons assms Pair by auto have chop: "chop (to_list v p) = (coef, i) # list" using Cons assms unfolding i'_def Pair by auto have p'_def : "p' = (∑(term, x)←chop (to_list v p). term * Var v ^ (x - i))" using assms Cons Pair by auto have p'_insertion : "insertion f p' = (∑(term, x)←chop (to_list v p). insertion f term * f v ^ (x - i))" proof- define d where "d = chop (to_list v p)" have "insertion f p' = insertion f (∑(term, x)←chop (to_list v p). term * Var v ^ (x - i))" using p'_def by auto also have "... = (∑(term, x)←chop (to_list v p). insertion f (term * Var v ^ (x - i)))" unfolding d_def[symmetric] apply(induction d) apply simp apply(simp add:insertion_add) by auto also have "... = (∑(term, x)←chop (to_list v p). insertion f term * f v ^ (x - i))" unfolding insertion_mult insertion_pow insert_Var_Zero by auto finally show ?thesis by auto qed have h : "(coef, i') # list = chop (to_list v p)" using Cons unfolding Pair by auto show ?thesis unfolding p'_insertion using move_exp[OF h, of f] unfolding i'_def . qed qed lemma unpower_eval: "eval (unpower v φ) L = eval φ L" proof(induction φ arbitrary: v L) case TrueF then show ?case by auto next case FalseF then show ?case by auto next case (Atom At) then show ?case proof(cases At) case (Less p) obtain q i where h: "decreasePower v p = (q, i)" using prod.exhaust_sel by blast have p : "⋀f. insertion f p = insertion f q* (f v)^i" using decreasePower_insertion[OF h] by auto show ?thesis proof(cases "i=0") case True then show ?thesis unfolding Less unpower.simps h by auto next case False obtain x where x_def : "Suc x = i" using False using not0_implies_Suc by auto have h1 : "i mod 2 = 0 ⟹ (insertion (nth_default 0 L) q < 0 ∧ insertion (nth_default 0 L) (Var v) ≠ 0) = (insertion (nth_default 0 L) q * nth_default 0 L v ^ i < 0)" proof - assume "i mod 2 = 0" then have "∀r. ¬ (r::real) ^ i < 0" by presburger then show ?thesis by (metis ‹⋀thesis. (⋀x. Suc x = i ⟹ thesis) ⟹ thesis› insert_Var_Zero linorder_neqE_linordered_idom mult_less_0_iff power_0_Suc power_eq_0_iff) qed show ?thesis unfolding Less unpower.simps h x_def[symmetric] apply simp unfolding x_def p apply(cases "i mod 2 = 0") using h1 apply simp_all by (smt insert_Var_Zero insertion_neg mod_Suc mod_eq_0D mult_less_0_iff nat.inject odd_power_less_zero power_0 power_Suc0_right power_eq_0_iff x_def zero_less_Suc zero_less_power) qed next case (Eq p) obtain q i where h: "decreasePower v p = (q, i)" using prod.exhaust_sel by blast have p : "⋀f. insertion f p = insertion f q* (f v)^i" using decreasePower_insertion[OF h] by auto show ?thesis unfolding Eq unpower.simps h apply simp apply(cases i) apply simp apply simp unfolding p apply simp by (metis insert_Var_Zero) next case (Leq p) obtain q i where h: "decreasePower v p = (q, i)" using prod.exhaust_sel by blast have p : "⋀f. insertion f p = insertion f q* (f v)^i" using decreasePower_insertion[OF h] by auto show ?thesis proof(cases "i=0") case True then show ?thesis unfolding Leq unpower.simps h by auto next case False obtain x where x_def : "Suc x = i" using False using not0_implies_Suc by auto define a where "a = insertion (nth_default 0 L) q" define x' where "x' = nth_default 0 L v" show ?thesis unfolding Leq unpower.simps h x_def[symmetric] apply simp unfolding x_def p apply(cases "i mod 2 = 0") unfolding insert_Var_Zero insertion_mult insertion_pow insertion_neg apply simp_all unfolding a_def[symmetric] x'_def[symmetric] proof- assume "i mod 2 = 0" then have "x' ^ i ≥0" by (simp add: ‹i mod 2 = 0› even_iff_mod_2_eq_zero zero_le_even_power) then show "(a ≤ 0 ∨ x' = 0) = (a * x' ^ i ≤ 0)" using Rings.ordered_semiring_0_class.mult_nonpos_nonneg[of a "x'^i"] apply auto unfolding Rings.linordered_ring_strict_class.mult_le_0_iff apply auto by (simp add: False power_0_left) next assume h: "i mod 2 = Suc 0" show "(a = 0 ∨ a < 0 ∧ 0 ≤ x' ∨ 0 < a ∧ x' ≤ 0) = (a * x' ^ i ≤ 0)" using h by (smt even_iff_mod_2_eq_zero mult_less_cancel_right mult_neg_neg mult_nonneg_nonpos mult_pos_pos not_mod2_eq_Suc_0_eq_0 power_0_Suc x_def zero_le_power_eq zero_less_mult_pos2 zero_less_power) qed qed next case (Neq p) obtain q i where h: "decreasePower v p = (q, i)" using prod.exhaust_sel by blast have p : "⋀f. insertion f p = insertion f q* (f v)^i" using decreasePower_insertion[OF h] by auto show ?thesis unfolding Neq unpower.simps h apply simp apply(cases i) apply simp apply simp unfolding p apply simp by (metis insert_Var_Zero) qed qed auto lemma to_list_filter: "p = sum_list [term * (Var v) ^ i. (term,i)←((filter (λ(x,_). x≠0) (to_list v p)))]" proof- define L where "L = to_list v p" have "(∑(term, i)←to_list v p. term * Var v ^ i) = (∑(term, i)←filter (λ(x, _). x ≠ 0) (to_list v p). term * Var v ^ i)" unfolding L_def[symmetric] apply(induction L) by auto then show ?thesis using to_list_p[of p v] by auto qed end
section "Algorithms" subsection "Equality VS Helper Functions" theory VSAlgos imports Debruijn Optimizations begin text "This is a subprocess which simply separates out the equality atoms from the other kinds of atoms Note that we search for equality atoms that are of degree one or two This is used within the equalityVS algorithm" fun find_eq :: "nat ⇒ atom list ⇒ real mpoly list * atom list" where "find_eq var [] = ([],[])"| "find_eq var ((Less p)#as) = (let (A,B) = find_eq var as in (A,Less p#B))" | "find_eq var ((Eq p)#as) = (let (A,B) = find_eq var as in if MPoly_Type.degree p var < 3 ∧ MPoly_Type.degree p var ≠ 0 then (p # A,B) else (A,Eq p # B) )"| "find_eq var ((Leq p)#as) = (let (A,B) = find_eq var as in (A,Leq p#B))" | "find_eq var ((Neq p)#as) = (let (A,B) = find_eq var as in (A,Neq p#B))" (* given ax^2+bx+c returns formula representing a=0 and b=0 and c=0 *) fun split_p :: "nat ⇒ real mpoly ⇒ atom fm" where "split_p var p = And (Atom (Eq (isolate_variable_sparse p var 2))) (And (Atom (Eq (isolate_variable_sparse p var 1))) (Atom (Eq (isolate_variable_sparse p var 0))))" text " The linearsubstitution virtually substitutes in an equation of $b*x+c=0$ into an arbitrary atom linearsubstitution x b c (Eq p) = F corresponds to removing variable x from polynomial p and replacing it with an equivalent function F where F doesn't mention variable x If there exists a way to assign variables that makes p = 0 true, then that same set of variables will make F true If there exists a way to assign variables that makes F true and also have b*x+c=0, then that same set of variables will make p=0 true Same applies for other kinds of atoms that aren't equality " fun linear_substitution :: "nat ⇒ real mpoly ⇒ real mpoly ⇒ atom ⇒ atom" where "linear_substitution var a b (Eq p) = (let d = MPoly_Type.degree p var in (Eq (∑i∈{0..<(d+1)}. isolate_variable_sparse p var i * (a^i) * (b^(d-i)))) )" | "linear_substitution var a b (Less p) = (let d = MPoly_Type.degree p var in let P = (∑i∈{0..<(d+1)}. isolate_variable_sparse p var i * (a^i) * (b^(d-i))) in (Less(P * (b ^ (d mod 2)))) )"| "linear_substitution var a b (Leq p) = (let d = MPoly_Type.degree p var in let P = (∑i∈{0..<(d+1)}. isolate_variable_sparse p var i * (a^i) * (b^(d-i))) in (Leq(P * (b ^ (d mod 2)))) )"| "linear_substitution var a b (Neq p) = (let d = MPoly_Type.degree p var in (Neq (∑i∈{0..<(d+1)}. isolate_variable_sparse p var i * (a^i) * (b^(d-i)))) )" fun linear_substitution_fm_helper :: "nat ⇒ real mpoly ⇒ real mpoly ⇒ atom fm ⇒ nat ⇒ atom fm" where "linear_substitution_fm_helper var b c F z = liftmap (λx.λA. Atom(linear_substitution (var+x) (liftPoly 0 x b) (liftPoly 0 x c) A)) F z" fun linear_substitution_fm :: "nat ⇒ real mpoly ⇒ real mpoly ⇒ atom fm ⇒ atom fm" where "linear_substitution_fm var b c F = linear_substitution_fm_helper var b c F 0" text " quadraticpart1 var a b A takes in an expression of the form (a+b * sqrt(c))/d for an arbitrary c and substitutes it in for the variable var in the atom A " fun quadratic_part_1 :: "nat ⇒ real mpoly ⇒ real mpoly ⇒ real mpoly ⇒ atom ⇒ real mpoly" where "quadratic_part_1 var a b d (Eq p) = ( let deg = MPoly_Type.degree p var in ∑i∈{0..<(deg+1)}. (isolate_variable_sparse p var i) * ((a+b*(Var var))^i) * (d^(deg - i)) )" | "quadratic_part_1 var a b d (Less p) = ( let deg = MPoly_Type.degree p var in let P = ∑i∈{0..<(deg+1)}. (isolate_variable_sparse p var i) * ((a+b*(Var var))^i) * (d^(deg - i)) in P * (d ^ (deg mod 2)) )"| "quadratic_part_1 var a b d (Leq p) = ( let deg = MPoly_Type.degree p var in let P = ∑i∈{0..<(deg+1)}. (isolate_variable_sparse p var i) * ((a+b*(Var var))^i) * (d^(deg - i)) in P * (d ^ (deg mod 2)) )"| "quadratic_part_1 var a b d (Neq p) = ( let deg = MPoly_Type.degree p var in ∑i∈{0..<(deg+1)}. (isolate_variable_sparse p var i) * ((a+b*(Var var))^i) * (d^(deg - i)) )" fun quadratic_part_2 :: "nat ⇒ real mpoly ⇒ real mpoly ⇒ real mpoly" where "quadratic_part_2 var sq p = ( let deg = MPoly_Type.degree p var in ∑i∈{0..<deg+1}. (isolate_variable_sparse p var i)*(sq^(i div 2)) * (Const(of_nat(i mod 2))) * (Var var) +(isolate_variable_sparse p var i)*(sq^(i div 2)) * Const(1-of_nat(i mod 2)) ) " text" quadraticsub var a b c d A represents virtually substituting an expression of the form (a+b*sqrt(c))/d into variable var in atom A " primrec quadratic_sub :: "nat ⇒ real mpoly ⇒ real mpoly ⇒ real mpoly ⇒ real mpoly ⇒ atom ⇒ atom fm" where "quadratic_sub var a b c d (Eq p) = ( let (p1::real mpoly) = quadratic_part_1 var a b d (Eq p) in let (p2::real mpoly) = quadratic_part_2 var c p1 in let (A::real mpoly) = isolate_variable_sparse p2 var 0 in let (B::real mpoly) = isolate_variable_sparse p2 var 1 in And (Atom(Leq (A*B))) (Atom (Eq (A^2-B^2*c))) )" | "quadratic_sub var a b c d (Less p) = ( let (p1::real mpoly) = quadratic_part_1 var a b d (Less p) in let (p2::real mpoly) = quadratic_part_2 var c p1 in let (A::real mpoly) = isolate_variable_sparse p2 var 0 in let (B::real mpoly) = isolate_variable_sparse p2 var 1 in Or (And (Atom(Less(A))) (Atom (Less (B^2*c-A^2)))) (And (Atom(Leq B)) (Or (Atom(Less A)) (Atom(Less (A^2-B^2*c))))) )" | "quadratic_sub var a b c d (Leq p) = ( let (p1::real mpoly) = quadratic_part_1 var a b d (Leq p) in let (p2::real mpoly) = quadratic_part_2 var c p1 in let (A::real mpoly) = isolate_variable_sparse p2 var 0 in let (B::real mpoly) = isolate_variable_sparse p2 var 1 in Or (And (Atom(Leq(A))) (Atom (Leq(B^2*c-A^2)))) (And (Atom(Leq B)) (Atom(Leq (A^2-B^2*c)))) )" | "quadratic_sub var a b c d (Neq p) = ( let (p1::real mpoly) = quadratic_part_1 var a b d (Neq p) in let (p2::real mpoly) = quadratic_part_2 var c p1 in let (A::real mpoly) = isolate_variable_sparse p2 var 0 in let (B::real mpoly) = isolate_variable_sparse p2 var 1 in Or (Atom(Less(-A*B))) (Atom (Neq(A^2-B^2*c))) )" fun quadratic_sub_fm_helper :: "nat ⇒ real mpoly ⇒ real mpoly ⇒ real mpoly ⇒ real mpoly ⇒ atom fm ⇒ nat ⇒ atom fm" where "quadratic_sub_fm_helper var a b c d F z = liftmap (λx.λA. quadratic_sub (var+x) (liftPoly 0 x a) (liftPoly 0 x b) (liftPoly 0 x c) (liftPoly 0 x d) A) F z" fun quadratic_sub_fm :: "nat ⇒ real mpoly ⇒ real mpoly ⇒ real mpoly ⇒ real mpoly ⇒ atom fm ⇒ atom fm" where "quadratic_sub_fm var a b c d F = quadratic_sub_fm_helper var a b c d F 0" subsection "General VS Helper Functions" (* allZero p var takes in a polynomial of the form sum a_i x^i where x is the variable var returns the formula where all a_i=0 *) fun allZero :: "real mpoly ⇒ nat ⇒ atom fm" where "allZero p var = list_conj [Atom(Eq(isolate_variable_sparse p var i)). i <- [0..<(MPoly_Type.degree p var)+1]]" fun alternateNegInfinity :: "real mpoly ⇒ nat ⇒ atom fm" where "alternateNegInfinity p var = foldl (λF.λi. let a_n = isolate_variable_sparse p var i in let exp = (if i mod 2 = 0 then Const(1) else Const(-1)) in or (Atom(Less (exp * a_n))) (and (Atom (Eq a_n)) F) ) FalseF ([0..<((MPoly_Type.degree p var)+1)])" (* substNegInfity var a substitutes negative infinity for the variable var in the atom a defined in pages 610-611 *) fun substNegInfinity :: "nat ⇒ atom ⇒ atom fm" where "substNegInfinity var (Eq p) = allZero p var " | "substNegInfinity var (Less p) = alternateNegInfinity p var"| "substNegInfinity var (Leq p) = Or (alternateNegInfinity p var) (allZero p var)"| "substNegInfinity var (Neq p) = Neg (allZero p var)" (* convertDerivative var p is equivalent to p^+ < 0 defined on page 615 around variable var *) function convertDerivative :: "nat ⇒ real mpoly ⇒ atom fm" where "convertDerivative var p = (if (MPoly_Type.degree p var) = 0 then Atom (Less p) else Or (Atom (Less p)) (And (Atom(Eq p)) (convertDerivative var (derivative var p))))" by pat_completeness auto termination apply(relation "measures [λ(var,p). MPoly_Type.degree p var]") apply auto using degree_derivative by (metis less_add_one) (* substInfinitesimalLinear var b c A substitutes -c/b+epsilon for variable var in atom A assumes b is nonzero defined in page 615 *) fun substInfinitesimalLinear :: "nat ⇒ real mpoly ⇒ real mpoly ⇒ atom ⇒ atom fm" where "substInfinitesimalLinear var b c (Eq p) = allZero p var"| "substInfinitesimalLinear var b c (Less p) = liftmap (λx. λA. Atom(linear_substitution (var+x) (liftPoly 0 x b) (liftPoly 0 x c) A)) (convertDerivative var p) 0"| "substInfinitesimalLinear var b c (Leq p) = Or (allZero p var) (liftmap (λx. λA. Atom(linear_substitution (var+x) (liftPoly 0 x b) (liftPoly 0 x c) A)) (convertDerivative var p) 0)"| "substInfinitesimalLinear var b c (Neq p) = neg (allZero p var)" (* substInfinitesimalQuadratic var a b c A substitutes (quadratic equation)+epsilon for variable var in atom A assumes a is nonzero and the determinant is positive defined in page 615 *) fun substInfinitesimalQuadratic :: "nat ⇒ real mpoly ⇒ real mpoly ⇒ real mpoly ⇒ real mpoly ⇒ atom ⇒ atom fm" where "substInfinitesimalQuadratic var a b c d (Eq p) = allZero p var"| "substInfinitesimalQuadratic var a b c d (Less p) = quadratic_sub_fm var a b c d (convertDerivative var p)"| "substInfinitesimalQuadratic var a b c d (Leq p) = Or (allZero p var) (quadratic_sub_fm var a b c d (convertDerivative var p))"| "substInfinitesimalQuadratic var a b c d (Neq p) = neg (allZero p var)" fun substInfinitesimalLinear_fm :: "nat ⇒ real mpoly ⇒ real mpoly ⇒ atom fm ⇒ atom fm" where "substInfinitesimalLinear_fm var b c F = liftmap (λx.λA. substInfinitesimalLinear (var+x) (liftPoly 0 x b) (liftPoly 0 x c) A) F 0" fun substInfinitesimalQuadratic_fm :: "nat ⇒ real mpoly ⇒ real mpoly ⇒ real mpoly ⇒ real mpoly ⇒ atom fm ⇒ atom fm" where "substInfinitesimalQuadratic_fm var a b c d F = liftmap (λx.λA. substInfinitesimalQuadratic (var+x) (liftPoly 0 x a) (liftPoly 0 x b) (liftPoly 0 x c) (liftPoly 0 x d) A) F 0" subsection "VS Algorithms" text "elimVar var L F attempts to do quadratic elimination on the variable defined by var. L is the list of conjuctive atoms, F is a list of unnecessary garbage" fun elimVar :: "nat ⇒ atom list ⇒ (atom fm) list ⇒ atom ⇒ atom fm" where "elimVar var L F (Eq p) = ( let (a,b,c) = get_coeffs var p in (Or (And (And (Atom (Eq a)) (Atom (Neq b))) (list_conj ( (map (λa. Atom (linear_substitution var (-c) b a)) L)@ (map (linear_substitution_fm var (-c) b) F) ))) (And (Atom (Neq a)) (And (Atom(Leq (-(b^2)+4*a*c))) (Or (list_conj ( (map (quadratic_sub var (-b) 1 (b^2-4*a*c) (2*a)) L)@ (map (quadratic_sub_fm var (-b) 1 (b^2-4*a*c) (2*a)) F) )) (list_conj ( (map (quadratic_sub var (-b) (-1) (b^2-4*a*c) (2*a)) L)@ (map (quadratic_sub_fm var (-b) (-1) (b^2-4*a*c) (2*a)) F) )) )) )) )" | "elimVar var L F (Less p) = ( let (a,b,c) = get_coeffs var p in (Or (And (And (Atom (Eq a)) (Atom (Neq b))) (list_conj ( (map (substInfinitesimalLinear var (-c) b) L) @(map (substInfinitesimalLinear_fm var (-c) b) F) ))) (And (Atom (Neq a)) (And (Atom(Leq (-(b^2)+4*a*c))) (Or (list_conj ( (map (substInfinitesimalQuadratic var (-b) 1 (b^2-4*a*c) (2*a)) L)@ (map (substInfinitesimalQuadratic_fm var (-b) 1 (b^2-4*a*c) (2*a)) F) )) (list_conj ( (map (substInfinitesimalQuadratic var (-b) (-1) (b^2-4*a*c) (2*a)) L)@ (map (substInfinitesimalQuadratic_fm var (-b) (-1) (b^2-4*a*c) (2*a)) F) )) )) )) )"| "elimVar var L F (Neq p) = ( let (a,b,c) = get_coeffs var p in (Or (And (And (Atom (Eq a)) (Atom (Neq b))) (list_conj ( (map (substInfinitesimalLinear var (-c) b) L) @(map (substInfinitesimalLinear_fm var (-c) b) F) ))) (And (Atom (Neq a)) (And (Atom(Leq (-(b^2)+4*a*c))) (Or (list_conj ( (map (substInfinitesimalQuadratic var (-b) 1 (b^2-4*a*c) (2*a)) L)@ (map (substInfinitesimalQuadratic_fm var (-b) 1 (b^2-4*a*c) (2*a)) F) )) (list_conj ( (map (substInfinitesimalQuadratic var (-b) (-1) (b^2-4*a*c) (2*a)) L)@ (map (substInfinitesimalQuadratic_fm var (-b) (-1) (b^2-4*a*c) (2*a)) F) )) )) ))) "| "elimVar var L F (Leq p) = ( let (a,b,c) = get_coeffs var p in (Or (And (And (Atom (Eq a)) (Atom (Neq b))) (list_conj ( (map (λa. Atom (linear_substitution var (-c) b a)) L)@ (map (linear_substitution_fm var (-c) b) F) ))) (And (Atom (Neq a)) (And (Atom(Leq (-(b^2)+4*a*c))) (Or (list_conj ( (map (quadratic_sub var (-b) 1 (b^2-4*a*c) (2*a)) L)@ (map (quadratic_sub_fm var (-b) 1 (b^2-4*a*c) (2*a)) F) )) (list_conj ( (map (quadratic_sub var (-b) (-1) (b^2-4*a*c) (2*a)) L)@ (map (quadratic_sub_fm var (-b) (-1) (b^2-4*a*c) (2*a)) F) )) )) )) )" (* single virtual substitution of equality *) fun qe_eq_one :: "nat ⇒ atom list ⇒ atom fm list ⇒ atom fm" where "qe_eq_one var L F = (case find_eq var L of (p#A,L') ⇒ Or (And (Neg (split_p var p)) ((elimVar var L F) (Eq p)) ) (And (split_p var p) (list_conj (map Atom ((map Eq A) @ L') @ F)) ) | ([],L') ⇒ list_conj ((map Atom L) @ F) )" fun check_nonzero_const :: "real mpoly ⇒ bool"where "check_nonzero_const p = (case get_if_const p of Some x ⇒ x ≠ 0 | None ⇒ False)" fun find_lucky_eq :: "nat ⇒ atom list ⇒ real mpoly option"where "find_lucky_eq v [] = None"| "find_lucky_eq v (Eq p#L) = (let (a,b,c) = get_coeffs v p in (if (MPoly_Type.degree p v = 1 ∨ MPoly_Type.degree p v = 2) ∧ (check_nonzero_const a ∨ check_nonzero_const b ∨ check_nonzero_const c) then Some p else find_lucky_eq v L ))"| "find_lucky_eq v (_#L) = find_lucky_eq v L" fun luckyFind :: "nat ⇒ atom list ⇒ atom fm list ⇒ atom fm option" where "luckyFind v L F = (case find_lucky_eq v L of Some p ⇒ Some ((elimVar v L F) (Eq p)) | None ⇒ None)" fun luckyFind' :: "nat ⇒ atom list ⇒ atom fm list ⇒ atom fm" where "luckyFind' v L F = (case find_lucky_eq v L of Some p ⇒ (elimVar v L F) (Eq p) | None ⇒ And (list_conj (map Atom L)) (list_conj F))" fun find_luckiest_eq :: "nat ⇒ atom list ⇒ real mpoly option"where "find_luckiest_eq v [] = None"| "find_luckiest_eq v (Eq p#L) = (if (MPoly_Type.degree p v = 1 ∨ MPoly_Type.degree p v = 2) then (let (a,b,c) = get_coeffs v p in (case get_if_const a of None ⇒ find_luckiest_eq v L | Some a ⇒ (case get_if_const b of None ⇒ find_luckiest_eq v L | Some b ⇒ (case get_if_const c of None ⇒ find_luckiest_eq v L | Some c ⇒ if a≠0∨b≠0∨c≠0 then Some p else find_luckiest_eq v L)))) else find_luckiest_eq v L )"| "find_luckiest_eq v (_#L) = find_luckiest_eq v L" fun luckiestFind :: "nat ⇒ atom list ⇒ atom fm list ⇒ atom fm" where "luckiestFind v L F = (case find_luckiest_eq v L of Some p ⇒ (elimVar v L F) (Eq p) | None ⇒ And (list_conj (map Atom L)) (list_conj F))" primrec qe_eq_repeat_helper :: "nat ⇒ real mpoly list ⇒ atom list ⇒ atom fm list ⇒ atom fm" where "qe_eq_repeat_helper var [] L F = list_conj ((map Atom L) @ F)"| "qe_eq_repeat_helper var (p#A) L F = Or (And (Neg (split_p var p)) ((elimVar var ((map Eq (p#A)) @ L) F) (Eq p)) ) (And (split_p var p) (qe_eq_repeat_helper var A L F) )" fun qe_eq_repeat :: "nat ⇒ atom list ⇒ atom fm list ⇒ atom fm" where "qe_eq_repeat var L F = (case luckyFind var L F of Some(F) ⇒ F | None ⇒ (let (A,L') = find_eq var L in qe_eq_repeat_helper var A L' F ) ) " fun all_degree_2 :: "nat ⇒ atom list ⇒ bool" where "all_degree_2 var [] = True"| "all_degree_2 var (Eq p#as) = ((MPoly_Type.degree p var ≤ 2)∧(all_degree_2 var as))"| "all_degree_2 var (Less p#as) = ((MPoly_Type.degree p var ≤ 2)∧(all_degree_2 var as))"| "all_degree_2 var (Leq p#as) = ((MPoly_Type.degree p var ≤ 2)∧(all_degree_2 var as))"| "all_degree_2 var (Neq p#as) = ((MPoly_Type.degree p var ≤ 2)∧(all_degree_2 var as))" fun gen_qe :: "nat ⇒ atom list ⇒ atom fm list ⇒ atom fm" where "gen_qe var L F = (case F of [] ⇒ (case luckyFind var L [] of Some F ⇒ F | None ⇒ ( (if all_degree_2 var L then list_disj (list_conj (map (substNegInfinity var) L) # (map (elimVar var L []) L)) else (qe_eq_repeat var L [])))) | _ ⇒ qe_eq_repeat var L F )" subsection "DNF" fun dnf :: "atom fm ⇒ (atom list * atom fm list) list" where "dnf TrueF = [([],[])]" | "dnf FalseF = []" | "dnf (Atom φ) = [([φ],[])]" | "dnf (And φ⇩1 φ⇩2) = [(A@B,A'@B').(A,A')←dnf φ⇩1,(B,B')←dnf φ⇩2]" | "dnf (Or φ⇩1 φ⇩2) = dnf φ⇩1 @ dnf φ⇩2" | "dnf (ExQ φ) = [([],[ExQ φ])]" | "dnf (Neg φ) = [([],[Neg φ])]"| "dnf (AllQ φ) = [([],[AllQ φ])]"| "dnf (AllN i φ) = [([],[AllN i φ])]"| "dnf (ExN i φ) = [([],[ExN i φ])]" text " dnf F returns the \"disjunctive normal form\" of F, but since F can contain quantifiers, we return (L,R,n) terms in a list. each term in the list represents a conjunction over the outside disjunctive list L is all the atoms we are able to reach, we are allowed to go underneath exists binders R is the remaining formulas (negation exists cannot be simplified) which are also under the same number of exist binders. n is the total number of binders each conjunct has " fun dnf_modified :: "atom fm ⇒ (atom list * atom fm list * nat) list" where "dnf_modified TrueF = [([],[],0)]" | "dnf_modified FalseF = []" | "dnf_modified (Atom φ) = [([φ],[],0)]" | "dnf_modified (And φ⇩1 φ⇩2) = [ let A = map (liftAtom d1 d2) A in let B = map (liftAtom 0 d1) B in let A' = map (liftFm d1 d2) A' in let B' = map (liftFm 0 d1) B' in (A @ B, A' @ B',d1+d2). (A,A',d1) ← dnf_modified φ⇩1, (B,B',d2) ← dnf_modified φ⇩2]" | "dnf_modified (Or φ⇩1 φ⇩2) = dnf_modified φ⇩1 @ dnf_modified φ⇩2" | "dnf_modified (ExQ φ) = [(A,A',d+1). (A,A',d) ← dnf_modified φ]" | "dnf_modified (Neg φ) = [([],[Neg φ],0)]"| "dnf_modified (AllQ φ) = [([],[AllQ φ],0)]"| "dnf_modified (AllN i φ) = [([],[AllN i φ],0)]"| "dnf_modified (ExN i φ) = [(A,A',d+i). (A,A',d) ← dnf_modified φ]" (* repeatedly applies nnf and dnf on subformulas and then attempts to eliminate the quantifier based on the qe quantifier elimination method given. Works on innermost variables first and builds out *) fun QE_dnf :: "(atom fm ⇒ atom fm) ⇒ (nat ⇒ nat ⇒ atom list ⇒ atom fm list ⇒ atom fm) ⇒ atom fm ⇒ atom fm" where "QE_dnf opt step (And φ⇩1 φ⇩2) = and (QE_dnf opt step φ⇩1) (QE_dnf opt step φ⇩2)" | "QE_dnf opt step (Or φ⇩1 φ⇩2) = or (QE_dnf opt step φ⇩1) (QE_dnf opt step φ⇩2)" | "QE_dnf opt step (Neg φ) = neg(QE_dnf opt step φ)" | "QE_dnf opt step (ExQ φ) = list_disj [ExN (n+1) (step 1 n al fl). (al,fl,n)←(dnf_modified(opt(QE_dnf opt step φ)))]"| "QE_dnf opt step (TrueF) = TrueF"| "QE_dnf opt step (FalseF) = FalseF"| "QE_dnf opt step (Atom a) = simp_atom a"| "QE_dnf opt step (AllQ φ) = Neg(list_disj [ExN (n+1) (step 1 n al fl). (al,fl,n)←(dnf_modified(opt(neg(QE_dnf opt step φ))))])"| "QE_dnf opt step (ExN 0 φ) = QE_dnf opt step φ"| "QE_dnf opt step (AllN 0 φ) = QE_dnf opt step φ"| "QE_dnf opt step (AllN (Suc i) φ) = Neg(list_disj [ExN (n+i+1) (step (Suc i) (n+i) al fl). (al,fl,n)←(dnf_modified(opt(neg(QE_dnf opt step φ))))])"| "QE_dnf opt step (ExN (Suc i) φ) = list_disj [ExN (n+i+1) (step (Suc i) (n+i) al fl). (al,fl,n)←(dnf_modified(opt(QE_dnf opt step φ)))]" fun QE_dnf' :: "(atom fm ⇒ atom fm) ⇒ (nat ⇒ (atom list * atom fm list * nat) list ⇒ atom fm) ⇒ atom fm ⇒ atom fm" where "QE_dnf' opt step (And φ⇩1 φ⇩2) = and (QE_dnf' opt step φ⇩1) (QE_dnf' opt step φ⇩2)" | "QE_dnf' opt step (Or φ⇩1 φ⇩2) = or (QE_dnf' opt step φ⇩1) (QE_dnf' opt step φ⇩2)" | "QE_dnf' opt step (Neg φ) = neg(QE_dnf' opt step φ)" | "QE_dnf' opt step (ExQ φ) = step 1 (dnf_modified(opt(QE_dnf' opt step φ)))"| "QE_dnf' opt step (TrueF) = TrueF"| "QE_dnf' opt step (FalseF) = FalseF"| "QE_dnf' opt step (Atom a) = simp_atom a"| "QE_dnf' opt step (AllQ φ) = Neg(step 1 (dnf_modified(opt(neg(QE_dnf' opt step φ)))))"| "QE_dnf' opt step (ExN 0 φ) = QE_dnf' opt step φ"| "QE_dnf' opt step (AllN 0 φ) = QE_dnf' opt step φ"| "QE_dnf' opt step (AllN (Suc i) φ) = Neg(step (Suc i) (dnf_modified(opt(neg(QE_dnf' opt step φ)))))"| "QE_dnf' opt step (ExN (Suc i) φ) = step (Suc i) (dnf_modified(opt(QE_dnf' opt step φ)))" subsection "Repeat QE multiple times" fun countQuantifiers :: "atom fm ⇒ nat" where "countQuantifiers (Atom _) = 0"| "countQuantifiers (TrueF) = 0"| "countQuantifiers (FalseF) = 0"| "countQuantifiers (And a b) = countQuantifiers a + countQuantifiers b"| "countQuantifiers (Or a b) = countQuantifiers a + countQuantifiers b"| "countQuantifiers (Neg a) = countQuantifiers a"| "countQuantifiers (ExQ a) = countQuantifiers a + 1"| "countQuantifiers (AllQ a) = countQuantifiers a + 1"| "countQuantifiers (ExN n a) = countQuantifiers a + n"| "countQuantifiers (AllN n a) = countQuantifiers a + n" fun repeatAmountOfQuantifiers_helper :: "(atom fm ⇒ atom fm) ⇒ nat ⇒ atom fm ⇒ atom fm" where "repeatAmountOfQuantifiers_helper step 0 F = F"| "repeatAmountOfQuantifiers_helper step (Suc i) F = repeatAmountOfQuantifiers_helper step i (step F)" fun repeatAmountOfQuantifiers :: "(atom fm ⇒ atom fm) ⇒ atom fm ⇒ atom fm" where "repeatAmountOfQuantifiers step F = ( let F = step F in let n = countQuantifiers F in repeatAmountOfQuantifiers_helper step n F )" end
subsection "Heuristic Algorithms" theory Heuristic imports VSAlgos Reindex Optimizations begin fun IdentityHeuristic :: "nat ⇒ atom list ⇒ atom fm list ⇒ nat" where "IdentityHeuristic n _ _ = n" fun step_augment :: "(nat ⇒ atom list ⇒ atom fm list ⇒ atom fm) ⇒ (nat ⇒ atom list ⇒ atom fm list ⇒ nat) ⇒ nat ⇒ nat ⇒ atom list ⇒ atom fm list ⇒ atom fm" where "step_augment step heuristic 0 var L F = list_conj (map fm.Atom L @ F)" | "step_augment step heuristic (Suc 0) 0 L F = step 0 L F" | "step_augment step heuristic _ 0 L F = list_conj (map fm.Atom L @ F)" | "step_augment step heuristic (Suc amount) (Suc i) L F =( let var = heuristic (Suc i) L F in let swappedL = map (swap_atom (i+1) var) L in let swappedF = map (swap_fm (i+1) var) F in list_disj[step_augment step heuristic amount i al fl. (al,fl)<-dnf ((push_forall ∘ nnf ∘ unpower 0 o groupQuantifiers o clearQuantifiers)(step (i+1) swappedL swappedF))])" fun the_real_step_augment :: "(nat ⇒ atom list ⇒ atom fm list ⇒ atom fm) ⇒ nat ⇒ (atom list * atom fm list * nat) list ⇒ atom fm" where "the_real_step_augment step 0 F = list_disj (map (λ(L,F,n). ExN n (list_conj (map fm.Atom L @ F))) F)" | "the_real_step_augment step (Suc amount) F =( ExQ (the_real_step_augment step amount (dnf_modified ((push_forall ∘ nnf ∘ unpower 0 o groupQuantifiers o clearQuantifiers)(list_disj(map (λ(L,F,n). ExN n (step (n+amount) L F)) F))))))" fun aquireData :: "nat ⇒ atom list ⇒ (nat fset*nat fset*nat fset)"where "aquireData n L = fold (λA (l,e,g). case A of Eq p ⇒ ( funion l (fset_of_list(filter (λv. let (a,b,c) = get_coeffs v p in ((MPoly_Type.degree p v = 1 ∨ MPoly_Type.degree p v = 2) ∧ (check_nonzero_const a ∨ check_nonzero_const b ∨ check_nonzero_const c))) [0..<(n+1)])), funion e (fset_of_list(filter (λv.(MPoly_Type.degree p v = 1 ∨ MPoly_Type.degree p v = 2)) [0..<(n+1)])) ,ffilter (λv. MPoly_Type.degree p v ≤ 2) g) | Leq p ⇒ (l,e,ffilter (λv. MPoly_Type.degree p v ≤ 2) g) | Neq p ⇒ (l,e,ffilter (λv. MPoly_Type.degree p v ≤ 2) g) | Less p ⇒ (l,e,ffilter (λv. MPoly_Type.degree p v ≤ 2) g) ) L (fempty,fempty,fset_of_list [0..<(n+1)])" datatype natpair = Pair "nat*nat" instantiation natpair :: linorder begin definition [simp]: "less_eq (A::natpair) B = (case A of Pair(a,b) ⇒ (case B of Pair(c,d) ⇒ if a=c then b≤d else a<c))" definition [simp]: "less (A::natpair) B = (case A of Pair(a,b) ⇒ (case B of Pair(c,d) ⇒ if a=c then b<d else a<c))" instance proof fix x :: natpair fix y :: natpair fix z :: natpair obtain a b where x : "x = Pair (a,b)" apply(cases x) by auto obtain c d where y : "y = Pair (c,d)" apply(cases y) by auto obtain e f where z : "z = Pair (e,f)" apply(cases z) by auto show "(x < y) = strict (≤) x y" unfolding x y by auto show "x≤x" unfolding x by auto show "x≤ y ⟹ y≤ z ⟹ x≤ z" unfolding x y z apply auto apply (metis dual_order.trans not_less_iff_gr_or_eq) by (metis less_trans) show "x ≤ y ⟹ y ≤ x ⟹ x = y" unfolding x y apply auto apply (metis not_less_iff_gr_or_eq) by (metis antisym_conv not_less_iff_gr_or_eq) show "x ≤ y ∨ y ≤ x" unfolding x y by auto qed end fun getBest :: "nat fset ⇒ atom list ⇒ nat option" where "getBest S L = (let X = fset_of_list(map (λx. Pair(count_list (map (λl. case l of Eq p ⇒ MPoly_Type.degree p x = 0 | Less p ⇒ MPoly_Type.degree p x = 0 | Neq p ⇒ MPoly_Type.degree p x = 0 | Leq p ⇒ MPoly_Type.degree p x = 0 ) L) False,x)) (sorted_list_of_fset S)) in (case (sorted_list_of_fset X) of [] ⇒ None | Cons (Pair(x,v)) _ ⇒ Some v)) " fun heuristicPicker :: "nat ⇒ atom list ⇒ atom fm list ⇒ (nat*(nat ⇒ atom list ⇒ atom fm list ⇒ atom fm)) option"where "heuristicPicker n L F = (case (let (l,e,g) = aquireData n L in (case getBest l L of None ⇒ (case F of [] ⇒ (case getBest g L of None ⇒ (case getBest e L of None ⇒ None | Some v ⇒ Some(v,qe_eq_repeat)) | Some v ⇒ Some(v,gen_qe) ) | _ ⇒ (case getBest e L of None ⇒ None | Some v ⇒ Some(v,qe_eq_repeat)) ) | Some v ⇒ Some(v,luckyFind') )) of None => None | Some(var,step) => (if var > n then None else Some(var,step)))" fun superPicker :: "nat ⇒ nat ⇒ atom list ⇒ atom fm list ⇒ atom fm" where "superPicker 0 var L F = list_conj (map fm.Atom L @ F)"| "superPicker amount 0 L F = (case heuristicPicker 0 L F of Some(0,step) ⇒ step 0 L F | _ ⇒ list_conj (map fm.Atom L @ F))" | "superPicker (Suc amount) (Suc i) L F =( case heuristicPicker (Suc i) L F of Some(var,step) ⇒ let swappedL = map (swap_atom (i+1) var) L in let swappedF = map (swap_fm (i+1) var) F in list_disj[superPicker amount i al fl. (al,fl)<-dnf ((push_forall ∘ nnf ∘ unpower 0 o groupQuantifiers o clearQuantifiers)(step (i+1) swappedL swappedF))] | None ⇒ list_conj (map fm.Atom L @ F))" datatype quadnat = Quad "nat × nat × nat × nat" instantiation quadnat :: linorder begin definition [simp]:"A<B = (case A of Quad(a1,b1,c1,d1) ⇒ (case B of Quad(a2,b2,c2,d2) ⇒ (if a1=a2 then ( if b1=b2 then ( if c1=c2 then d1<d2 else c1<c2 ) else b1<b2 ) else a1<a2)))" definition [simp]:"A≤B = (case A of Quad(a1,b1,c1,d1) ⇒ (case B of Quad(a2,b2,c2,d2) ⇒ (if a1=a2 then ( if b1=b2 then ( if c1=c2 then d1≤d2 else c1<c2 ) else b1<b2 ) else a1<a2)))" instance proof fix x y z obtain a1 b1 c1 d1 where x : "x = Quad(a1,b1,c1,d1)" by (metis prod_cases4 quadnat.exhaust) obtain a2 b2 c2 d2 where y : "y = Quad(a2,b2,c2,d2)" by (metis prod_cases4 quadnat.exhaust) obtain a3 b3 c3 d3 where z : "z = Quad(a3,b3,c3,d3)" by (metis prod_cases4 quadnat.exhaust) show "(x < y) = strict (≤) x y" unfolding x y by auto show "x ≤ x" unfolding x by auto show "x ≤ y ⟹ y ≤ z ⟹ x ≤ z" unfolding x y z apply auto apply (metis dual_order.trans not_less_iff_gr_or_eq) apply (metis less_trans) apply (metis dual_order.strict_trans not_less_iff_gr_or_eq) apply (metis less_trans) apply (metis dual_order.strict_trans not_less_iff_gr_or_eq) apply (metis less_trans) apply (metis less_trans not_less_iff_gr_or_eq) by (metis less_trans) show "x ≤ y ⟹ y ≤ x ⟹ x = y" unfolding x y apply auto apply (metis less_imp_not_less) apply (metis not_less_iff_gr_or_eq) apply (metis not_less_iff_gr_or_eq) by (metis antisym_conv not_less_iff_gr_or_eq) show "x ≤ y ∨ y ≤ x" unfolding x y by auto qed end fun brownsHeuristic :: "nat ⇒ atom list ⇒ atom fm list ⇒ nat" where "brownsHeuristic n L _ = (case sorted_list_of_fset (fset_of_list (map (λx. case (foldl (λ(maxdeg,totaldeg,appearancecount) l. let p = case l of Eq p ⇒ p | Less p ⇒ p | Leq p ⇒ p | Neq p ⇒ p in let deg = MPoly_Type.degree p x in (max maxdeg deg,totaldeg+deg,appearancecount+(if deg>0 then 1 else 0))) (0,0,0) L) of (a,b,c) ⇒ Quad(a,b,c,x) ) [0..<n])) of [] ⇒ n | Cons (Quad(_,_,_,x)) _ ⇒ if x>n then n else x)" end
theory PrettyPrinting imports ExecutiblePolyProps PolyAtoms Polynomials.Show_Polynomials Polynomials.Power_Products begin global_interpretation drlex_pm: linorder drlex_pm drlex_pm_strict defines Min_drlex_pm = "linorder.Min drlex_pm" and Max_drlex_pm = "linorder.Max drlex_pm" and sorted_drlex_pm = "linorder.sorted drlex_pm" and sorted_list_of_set_drlex_pm = "linorder.sorted_list_of_set drlex_pm" and sort_key_drlex_pm = "linorder.sort_key drlex_pm" and insort_key_drlex_pm = "linorder.insort_key drlex_pm" and part_drlex_pm = "drlex_pm.part" apply unfold_locales subgoal by (simp add: drlex_pm_strict_def) subgoal by (simp add: drlex_pm_refl) subgoal using drlex_pm_trans by auto subgoal by (simp add: drlex_pm_antisym) subgoal by (simp add: drlex_pm_lin) done definition "monomials_list mp = drlex_pm.sorted_list_of_set (monomials mp)" definition shows_monomial_gen::"((nat × nat) ⇒ shows) ⇒ ('a ⇒ shows) ⇒ shows ⇒ (nat ⇒⇩0 nat) ⇒ 'a option ⇒ shows" where "shows_monomial_gen shows_factor shows_coeff sep mon cff = shows_sep (λs. case s of Inl cff ⇒ shows_coeff cff | Inr factor ⇒ shows_factor factor ) sep ((case cff of None ⇒ [] | Some cff ⇒ [Inl cff]) @ map Inr (Poly_Mapping.items mon))" definition "shows_factor_compact factor = (case factor of (k, v) ⇒ shows_string ''x'' +@+ shows k +@+ (if v = 1 then shows_string '''' else shows_string ''^'' +@+ shows v))" definition "shows_factor_Var factor = (case factor of (k, v) ⇒ shows_string ''(Var '' +@+ shows k +@+ shows_string '')'' +@+ (if v = 1 then shows_string '''' else shows_string ''^'' +@+ shows v))" definition shows_monomial_compact::"('a ⇒ shows) ⇒ (nat ⇒⇩0 nat) ⇒ 'a option ⇒ shows" where "shows_monomial_compact shows_coeff m = shows_monomial_gen shows_factor_compact shows_coeff (shows_string '' '') m" definition shows_monomial_Var::"('a ⇒ shows) ⇒ (nat ⇒⇩0 nat) ⇒ 'a option ⇒ shows" where "shows_monomial_Var shows_coeff m = shows_monomial_gen shows_factor_Var shows_coeff (shows_string ''*'') m" fun shows_mpoly :: "bool ⇒ ('a ⇒ shows) ⇒ 'a::{zero,one} mpoly ⇒ shows" where "shows_mpoly input shows_coeff p = shows_sep (λmon. (if input then shows_monomial_Var (λx. shows_paren (shows_string ''Const '' +@+ shows_paren (shows_coeff x))) else shows_monomial_compact shows_coeff) mon (let cff = MPoly_Type.coeff p mon in if cff = 1 then None else Some cff) ) (shows_string '' + '') (monomials_list p)" definition "rat_of_real (x::real) = (if (∃r::rat. x = of_rat r) then (THE r. x = of_rat r) else 99999999999.99999999999)" lemma rat_of_real: "rat_of_real x = r" if "x = of_rat r" using that unfolding rat_of_real_def by simp lemma rat_of_real_code[code]: "rat_of_real (Ratreal r) = r" by (simp add: rat_of_real) definition "shows_real x = shows (rat_of_real x)" experiment begin abbreviation "foo ≡ ((Var 0::real mpoly) + Const (0.5) * Var 1 + Var 2)^3" value [code] "shows_mpoly True shows_real foo ''''" (* rhs of foo\\_eq is the output of this ‹value› command *) lemma foo_eq: "foo = (Var 0)^3 + (Const (3/2))*(Var 0)^2*(Var 1) + (Const (3))*(Var 0)^2*(Var 2) + (Const (3/4))*(Var 0)*(Var 1)^2 + (Const (3))*(Var 0)*(Var 1)*(Var 2) + (Const (3))*(Var 0)*(Var 2)^2 + (Const (1/8))*(Var 1)^3 + (Const (3/4))*(Var 1)^2*(Var 2) + (Const (3/2))*(Var 1)*(Var 2)^2 + (Var 2)^3" by code_simp value [code] "shows_mpoly False shows_real foo ''''" value [code] "shows_mpoly False (shows_paren o shows_mpoly False shows_real) (extract_var foo 0) ''''" value [code] "shows_list_gen (shows_mpoly False shows_real) ''[]'' ''['' '', '' '']'' (Polynomial.coeffs (mpoly_to_nested_poly foo 0)) ''''" end fun shows_atom :: "bool ⇒ atom ⇒ shows" where "shows_atom c (Eq p) = (shows_string ''('' +@+ shows_mpoly c shows_real p +@+ shows_string ''=0)'')"| "shows_atom c (Less p) = (shows_string ''('' +@+ shows_mpoly c shows_real p +@+ shows_string ''<0)'')"| "shows_atom c (Leq p) = (shows_string ''('' +@+ shows_mpoly c shows_real p +@+ shows_string ''<=0)'')"| "shows_atom c(Neq p) = (shows_string ''('' +@+ shows_mpoly c shows_real p +@+ shows_string ''~=0)'')" fun depth' :: "'a fm ⇒ nat"where "depth' TrueF = 1"| "depth' FalseF = 1"| "depth' (Atom _) = 1"| "depth' (And φ ψ) = max (depth' φ) (depth' ψ) + 1"| "depth' (Or φ ψ) = max (depth' φ) (depth' ψ) + 1"| "depth' (Neg φ) = depth' φ + 1"| "depth' (ExQ φ) = depth' φ + 1"| "depth' (AllQ φ) = depth' φ + 1"| "depth' (AllN i φ) = depth' φ + i * 2 + 1"| "depth' (ExN i φ) = depth' φ + i * 2 + 1" function shows_fm :: "bool ⇒ atom fm ⇒ shows" where "shows_fm c (Atom a) = shows_atom c a"| "shows_fm c (TrueF) = shows_string ''(T)''"| "shows_fm c (FalseF) = shows_string ''(F)''"| "shows_fm c (And φ ψ) = (shows_string ''('' +@+ shows_fm c φ +@+ shows_string '' and '' +@+ shows_fm c ψ +@+ shows_string ('')''))"| "shows_fm c (Or φ ψ) = (shows_string ''('' +@+ shows_fm c φ +@+ shows_string '' or '' +@+ shows_fm c ψ +@+ shows_string '')'')"| "shows_fm c (Neg φ) = (shows_string ''(neg '' +@+ shows_fm c φ +@+ shows_string '')'')"| "shows_fm c (ExQ φ) = (shows_string ''(exists'' +@+ shows_fm c φ +@+ shows_string '')'')"| "shows_fm c (AllQ φ) = (shows_string ''(forall'' +@+ shows_fm c φ +@+ shows_string '')'')"| "shows_fm c (ExN 0 φ) = shows_fm c φ"| "shows_fm c (ExN (Suc n) φ) = shows_fm c (ExQ(ExN n φ))"| "shows_fm c (AllN 0 φ) = shows_fm c φ"| "shows_fm c (AllN (Suc n) φ) = shows_fm c (AllQ(AllN n φ))" by pat_completeness auto termination apply(relation "measures [λ(_,A). depth' A]") by auto value "shows_fm False (ExQ (Or (AllQ(And (Neg TrueF) (Neg FalseF))) (Atom(Eq(Const 4))))) []" value "shows_fm True (ExQ (Or (AllQ(And (Neg TrueF) (Neg FalseF))) (Atom(Eq(Const 4))))) []" end
subsection "Top-Level Algorithms" theory Exports imports Heuristic VSAlgos Optimizations (*"HOL-Library.Code_Real_Approx_By_Float"*) HOL.String "HOL-Library.Code_Target_Int" "HOL-Library.Code_Target_Nat" PrettyPrinting Show.Show_Real begin definition "opt = (push_forall ∘ nnf ∘ unpower 0 o clearQuantifiers)" definition "opt_group = (push_forall ∘ nnf ∘ unpower 0 o groupQuantifiers o clearQuantifiers)" definition "VSLuckiest = opt o (QE_dnf opt (λamount. luckiestFind)) o opt" definition "VSLuckiestBlocks =opt_group o (QE_dnf' opt_group (the_real_step_augment luckiestFind)) o opt_group" definition "VSEquality =opt o (QE_dnf opt(λx. qe_eq_repeat)) o VSLuckiest o opt " definition "VSEqualityBlocks =opt_group o (QE_dnf' opt_group (the_real_step_augment qe_eq_repeat)) o VSLuckiestBlocks o opt_group" definition "VSGeneralBlocks =opt_group o (QE_dnf' opt_group (the_real_step_augment gen_qe))o VSLuckiestBlocks o opt_group" definition "VSLuckyBlocks =opt_group o (QE_dnf' opt_group (the_real_step_augment luckyFind'))o VSLuckiestBlocks o opt_group" definition "VSLEGBlocks = VSGeneralBlocks o VSEqualityBlocks o VSLuckyBlocks" definition "VSEqualityBlocksLimited =opt_group o (QE_dnf opt_group (step_augment qe_eq_repeat IdentityHeuristic)) o VSLuckiestBlocks o opt_group" definition "VSEquality_3_times = VSEquality o VSEquality o VSEquality" definition "VSGeneral = opt o (QE_dnf opt (λx. gen_qe)) o VSLuckiest o opt" definition "VSGeneralBlocksLimited = opt_group o (QE_dnf opt_group (step_augment gen_qe IdentityHeuristic)) o VSLuckiestBlocks o opt_group" definition "VSBrowns = opt_group o (QE_dnf opt_group (step_augment gen_qe brownsHeuristic)) o VSLuckiestBlocks o opt_group" definition "VSGeneral_3_times = VSGeneral o VSGeneral o VSGeneral" definition "VSLucky = opt o (QE_dnf opt (λamount. luckyFind')) o VSLuckiest o opt" definition "VSLuckyBlocksLimited = opt_group o (QE_dnf opt_group (step_augment luckyFind' IdentityHeuristic)) o VSLuckiestBlocks o opt_group" definition "VSLEG = VSGeneral o VSEquality o VSLucky" definition "VSHeuristic = opt_group o (QE_dnf opt_group (superPicker)) o VSLuckiestBlocks o opt_group" definition "VSLuckiestRepeat = repeatAmountOfQuantifiers VSLuckiest" definition add :: "real mpoly ⇒ real mpoly ⇒ real mpoly" where "add p q = p + q" definition minus :: "real mpoly ⇒ real mpoly ⇒ real mpoly" where "minus p q = p - q" definition mult :: "real mpoly ⇒ real mpoly ⇒ real mpoly" where "mult p q = p * q" definition pow :: "real mpoly ⇒ integer ⇒ real mpoly" where "pow p n = p ^ (nat_of_integer n)" definition C :: "real ⇒ real mpoly" where "C r = Const r" definition V :: "integer ⇒ real mpoly" where "V n = Var (nat_of_integer n)" definition real_of_int :: "integer ⇒ real" where "real_of_int n = real (nat_of_integer n)" definition real_mult :: "real ⇒ real ⇒ real" where "real_mult n m = n * m" definition real_div :: "real ⇒ real ⇒ real" where "real_div n m = n / m" definition real_plus :: "real ⇒ real ⇒ real" where "real_plus n m = n + m" definition real_minus :: "real ⇒ real ⇒ real" where "real_minus n m = n - m" fun is_quantifier_free :: "atom fm ⇒ bool" where "is_quantifier_free (ExQ x) =False"| "is_quantifier_free (AllQ x) =False"| "is_quantifier_free (And a b) =(is_quantifier_free a ∧ is_quantifier_free b)"| "is_quantifier_free (Or a b) =(is_quantifier_free a ∧ is_quantifier_free b)"| "is_quantifier_free (Neg a) =is_quantifier_free a"| "is_quantifier_free a = True" fun is_solved :: "atom fm ⇒ bool" where "is_solved TrueF = True"| "is_solved FalseF = True"| "is_solved A = False" definition print_mpoly :: "(real ⇒ String.literal)⇒ real mpoly ⇒ String.literal" where "print_mpoly f p = String.implode ((shows_mpoly True (λx.λy. (String.explode o f) x @ y)) p '''')" definition "Unpower = unpower 0" export_code print_mpoly VSGeneral VSEquality VSLucky VSLEG VSLuckiest VSGeneralBlocksLimited VSEqualityBlocksLimited VSLuckyBlocksLimited VSGeneralBlocks VSEqualityBlocks VSLuckyBlocks VSLEGBlocks VSLuckiestBlocks QE_dnf gen_qe qe_eq_repeat simpfm push_forall nnf Unpower is_quantifier_free is_solved add mult C V pow minus Eq Or is_quantifier_free real_of_int real_mult real_div real_plus real_minus VSGeneral_3_times VSEquality_3_times VSHeuristic VSLuckiestRepeat VSBrowns in SML module_name VS end
section "Equality VS Proofs" subsection "Linear Case" theory LinearCase imports VSAlgos begin theorem var_not_in_linear : assumes "var ∉ vars b" assumes "var ∉ vars c" shows "freeIn var (Atom (linear_substitution var b c A))" proof(cases A) case (Less p) define d where "d = MPoly_Type.degree p var" then show ?thesis using Less apply simp unfolding d_def[symmetric] apply simp using not_in_sum using not_in_isovarspar assms not_in_mult not_in_neg not_in_pow not_in_add by (metis (no_types, lifting)) next case (Eq p) define d where "d = MPoly_Type.degree p var" then show ?thesis using Eq apply simp unfolding d_def[symmetric] apply simp using not_in_sum using not_in_isovarspar assms not_in_mult not_in_neg not_in_pow not_in_add by (metis (no_types, lifting)) next case (Leq p) define d where "d = MPoly_Type.degree p var" then show ?thesis using Leq apply simp unfolding d_def[symmetric] apply simp using not_in_sum using not_in_isovarspar assms not_in_mult not_in_neg not_in_pow not_in_add by (metis (no_types, lifting)) next case (Neq p) define d where "d = MPoly_Type.degree p var" then show ?thesis using Neq apply simp unfolding d_def[symmetric] apply simp using not_in_sum using not_in_isovarspar assms not_in_mult not_in_neg not_in_pow not_in_add by (metis (no_types, lifting)) qed (* ----------------------------------------------------------------------------------------------- *) lemma linear_eq : assumes lLength : "length L > var" assumes nonzero : "C ≠ 0" assumes "var ∉ vars b" assumes "var ∉ vars c" assumes hb : "insertion (nth_default 0 (list_update L var( B/C))) b = (B::real)" assumes hc : "insertion (nth_default 0 (list_update L var (B/C))) c = (C::real)" shows "aEval (Eq(p)) (list_update L var (B/C)) = (aEval (linear_substitution var b c (Eq(p))) (list_update L var v))" proof - define d where "d = MPoly_Type.degree p var" define f where "f i = (insertion (nth_default 0 (list_update L var (B/C))) (isolate_variable_sparse p var i) * (B) ^ i::real)" for i have h : "((∑i = 0..<d+1. f i / C ^ i) = 0) =((∑i = 0..<d+1. (f i) * C ^ (d - i)) = 0)" using normalize_summation nonzero by(auto) have "aEval (linear_substitution var b c (Eq(p))) (list_update L var (B/C)) = aEval (Eq(∑i = 0..<d+1. isolate_variable_sparse p var i * (b) ^ i * c ^ (d - i))) (list_update L var (B/C))" by (metis (no_types, lifting) d_def linear_substitution.simps(1) sum.cong) also have "... = ((∑i = 0..<(d+1). insertion (nth_default 0 (list_update L var (B/C))) (isolate_variable_sparse p var i) * (B) ^ i * C ^ (d - i)) = 0)" using assms by(simp add: insertion_sum insertion_mult insertion_add insertion_pow insertion_neg lLength) also have "... = ((∑i = 0..<(d+1). insertion (nth_default 0 (list_update L var (B/C))) (isolate_variable_sparse p var i) * (B) ^ i/ (C ^ i)) = 0)" using h by(simp add: f_def) also have "... = ((∑i = 0..<(d+1). insertion (nth_default 0 (list_update L var (B/C))) (isolate_variable_sparse p var i) * ((B/C) ^ i)) = 0)" by (metis (no_types, lifting) power_divide sum.cong times_divide_eq_right) also have "... = aEval (Eq(p :: real mpoly)) (list_update L var (B/C))" using sum_over_degree_insertion d_def lLength by auto finally show ?thesis using assms plugInLinear var_not_in_linear var_not_in_eval by (meson var_not_in_aEval) qed (* -------------------------------------------------------------------------------------------- *) lemma linear_less : assumes lLength : "length L > var" assumes nonzero : "C ≠ 0" assumes "var ∉ vars b" assumes "var ∉ vars c" assumes "insertion (nth_default 0 (list_update L var (B/C))) b = (B::real)" assumes "insertion (nth_default 0 (list_update L var (B/C))) c = (C::real)" shows "aEval (Less(p)) (list_update L var (B/C)) = (aEval (linear_substitution var b c (Less(p))) (list_update L var v))" proof- define d where "d = MPoly_Type.degree p var" define f where "f i = (insertion (nth_default 0 (list_update L var (B/C))) (isolate_variable_sparse p var i) * (B) ^ i::real)" for i have h : "(∑i = 0..<(d+1). (f i) * C ^ (d - i)) * C ^ (d mod 2) < 0 ⟷ (∑i = 0..<((d::nat)+1). (f i::real) / (C ^ i)) < 0" using nonzero normalize_summation_less by auto have "aEval (linear_substitution var b c (Less(p))) (list_update L var (B/C))=aEval (Less((∑i∈{0..<(d+1)}. isolate_variable_sparse p var i * (b^i) * (c^(d-i))) * (c ^ (d mod 2)))) (list_update L var (B/C))" by (metis (no_types, lifting) d_def linear_substitution.simps(2) sum.cong) also have "... = ((∑i = 0..<(d+1). insertion (nth_default 0 (list_update L var (B/C))) (isolate_variable_sparse p var i) * (B) ^ i * C ^ (d - i)) * C ^ (d mod 2) < 0)" using assms by(simp add: insertion_sum insertion_mult insertion_add insertion_pow insertion_neg lLength) also have "... = ((∑i = 0..<(d+1). insertion (nth_default 0 (list_update L var (B/C))) (isolate_variable_sparse p var i) * (((B) ^ i) / (C ^ i))) < 0)" using f_def h by auto also have "... = ((∑i = 0..<(d+1). insertion (nth_default 0 (list_update L var (B/C))) (isolate_variable_sparse p var i) * (B/C)^i) < 0)" by (metis (no_types, lifting) power_divide sum.cong) also have "... = aEval (Less(p)) (list_update L var (B/C))" using d_def sum_over_degree_insertion lLength by auto finally show ?thesis using assms plugInLinear var_not_in_linear var_not_in_eval by (meson var_not_in_aEval) qed (* -------------------------------------------------------------------------------------------- *) lemma linear_leq : assumes lLength : "length L > var" assumes nonzero : "C ≠ 0" assumes "var ∉ vars b" assumes "var ∉ vars c" assumes "insertion (nth_default 0 (list_update L var (B/C))) b = (B::real)" assumes "insertion (nth_default 0 (list_update L var (B/C))) c = (C::real)" shows "aEval (Leq(p)) (list_update L var (B/C)) = (aEval (linear_substitution var b c (Leq(p))) (list_update L var v))" proof - define d where "d = MPoly_Type.degree p var" define f where "f i = (insertion (nth_default 0 (list_update L var (B/C))) (isolate_variable_sparse p var i) * (B) ^ i::real)" for i have h1a : "((∑i = 0..<(d+1). (f i) * C ^ (d - i)) * C ^ (d mod 2) < 0 ) = ((∑i = 0..<((d::nat)+1). (f i::real) / (C ^ i)) < 0)" using nonzero normalize_summation_less by auto have "((∑i = 0..<d+1. f i / C ^ i) = 0) =((∑i = 0..<d+1. (f i) * C ^ (d - i)) = 0)" using normalize_summation nonzero by(auto) also have "... =((∑i = 0..<d+1. (f i) * C ^ (d - i))* C ^ (d mod 2) = 0)" using mult_eq_0_iff nonzero power_not_zero by blast finally have h1 : "((∑i = 0..<(d+1). (f i) * C ^ (d - i)) * C ^ (d mod 2) ≤ 0 ) = ((∑i = 0..<((d::nat)+1). (f i::real) / (C ^ i)) ≤ 0)" using h1a by smt have "aEval (linear_substitution var b c (Leq(p))) (list_update L var (B/C))=aEval (Leq((∑i∈{0..<(d+1)}. isolate_variable_sparse p var i * (b^i) * (c^(d-i))) * (c ^ (d mod 2)))) (list_update L var (B/C))" by (metis (no_types, lifting) d_def linear_substitution.simps(3) sum.cong) also have "... = ((∑i = 0..<(d+1). insertion (nth_default 0 (list_update L var (B/C))) (isolate_variable_sparse p var i) * (B) ^ i * C ^ (d - i)) * C ^ (d mod 2) ≤ 0)" using assms by(simp add: insertion_sum insertion_mult insertion_add insertion_pow insertion_neg lLength) also have"...= ((∑i = 0..<(d+1). (insertion (nth_default 0 (list_update L var (B/C))) (isolate_variable_sparse p var i) * (B) ^ i) / (C ^ i)) ≤ 0)" using h1 f_def by auto also have "... = ((∑i = 0..<(d+1). insertion (nth_default 0 (list_update L var (B/C))) (isolate_variable_sparse p var i) * (((B) ^ i) / (C ^ i))) ≤ 0)" by auto also have "... = ((∑i = 0..<(d+1). insertion (nth_default 0 (list_update L var (B/C))) (isolate_variable_sparse p var i) * (B/C)^i) ≤ 0)" by (metis (no_types, lifting) power_divide sum.cong) also have "... = aEval (Leq(p)) (list_update L var (B/C))" using d_def sum_over_degree_insertion lLength by auto finally show ?thesis using assms plugInLinear var_not_in_eval var_not_in_linear by (meson var_not_in_aEval) qed (* ----------------------------------------------------------------------------------------------- *) lemma linear_neq : assumes lLength : "length L > var" assumes nonzero : "C ≠ 0" assumes "var ∉ vars b" assumes "var ∉ vars c" assumes "insertion (nth_default 0 (list_update L var (B/C))) b = (B::real)" assumes "insertion (nth_default 0 (list_update L var (B/C))) c = (C::real)" shows "aEval (Neq(p)) (list_update L var (B/C)) = (aEval (linear_substitution var b c (Neq(p))) (list_update L var v))" proof - define d where "d = MPoly_Type.degree p var" have "aEval (Eq(p)) (list_update L var (B/C)) = (∀v. aEval (linear_substitution var b c (Eq(p))) (list_update L var v))" using linear_eq assms by auto also have "... = (∀v. eval (Atom (Eq ((∑i = 0..<d+1. isolate_variable_sparse p var i * (b) ^ i * c ^ (d - i))))) (list_update L var v))" by (metis (no_types, lifting) d_def eval.simps(1) linear_substitution.simps(1) sum.cong) also have "... = (¬(∀v. eval (Atom (Neq ((∑i = 0..<d+1. isolate_variable_sparse p var i * (b) ^ i * c ^ (d - i))))) (list_update L var v)))" by (metis (no_types, lifting) aEval.simps(1) aEval.simps(4) eval.simps(1) assms(3) assms(4) not_contains_insertion not_in_isovarspar not_in_mult not_in_pow not_in_sum) also have "... = (¬(∀v. aEval (linear_substitution var b c (Neq(p))) (list_update L var v)))" by (metis (full_types) d_def eval.simps(1) linear_substitution.simps(4)) finally have "... = (¬(aEval (Neq(p)) (list_update L var (B/C))))" by simp then show ?thesis using assms(3) assms(4) var_not_in_aEval var_not_in_linear by blast qed (* -------------------------------------------------------------------------------------------- *) theorem linear : assumes lLength : "length L > var" assumes "C ≠ 0" assumes "var ∉ vars b" assumes "var ∉ vars c" assumes "insertion (nth_default 0 (list_update L var (B/C))) b = (B::real)" assumes "insertion (nth_default 0 (list_update L var (B/C))) c = (C::real)" shows "aEval A (list_update L var (B/C)) = (aEval (linear_substitution var b c A) (list_update L var v))" apply(cases A) using linear_less[OF assms(1-6)] linear_eq[OF assms(1-6)] linear_leq[OF assms(1-6)] linear_neq[OF assms(1-6)] by auto lemma var_not_in_linear_fm_helper : assumes "var ∉ vars b" assumes "var ∉ vars c" shows "freeIn (var+z) (linear_substitution_fm_helper var b c F z)" proof(induction F arbitrary: z) case TrueF then show ?case by(simp) next case FalseF then show ?case by simp next case (Atom x) show ?case unfolding linear_substitution_fm_helper.simps liftmap.simps using var_not_in_linear[OF not_in_lift[OF assms(1)] not_in_lift[OF assms(2)], of z] by blast next case (And F1 F2) then show ?case by simp next case (Or F1 F2) then show ?case by simp next case (Neg F) then show ?case by simp next case (ExQ F) show ?case using ExQ[of "z+1"] by simp next case (AllQ F) show ?case using AllQ[of "z+1"] by simp next case (ExN x1 φ) then show ?case by (metis (no_types, lifting) freeIn.simps(13) group_cancel.add1 liftmap.simps(10) linear_substitution_fm_helper.simps) next case (AllN x1 φ) then show ?case by (metis (no_types, lifting) freeIn.simps(12) group_cancel.add1 liftmap.simps(9) linear_substitution_fm_helper.simps) qed theorem var_not_in_linear_fm : assumes "var ∉ vars b" assumes "var ∉ vars c" shows "freeIn var (linear_substitution_fm var b c F)" using var_not_in_linear_fm_helper[OF assms, of 0] by auto lemma linear_fm_helper : assumes "C ≠ 0" assumes "var ∉ vars b" assumes "var ∉ vars c" assumes "insertion (nth_default 0 (list_update (drop z L) var (B/C))) b = (B::real)" assumes "insertion (nth_default 0 (list_update (drop z L) var (B/C))) c = (C::real)" assumes lLength : "length L > var+z" shows "eval F (list_update L (var+z) (B/C)) = (eval (linear_substitution_fm_helper var b c F z) (list_update L (var+z) v))" using assms proof(induction F arbitrary:z L) case TrueF then show ?case by auto next case FalseF then show ?case by auto next case (Atom x) define L1 where "L1 = drop z L" define L2 where "L2 = take z L" have L_def : "L = L2 @ L1" using L1_def L2_def by auto have h1a : "insertion (nth_default 0 L1) b = B" using not_contains_insertion[OF Atom(2), of L1 "B/C" B] Atom(4) unfolding L1_def nth_default_def by (metis list_update_id) have lengthl2 : "length L2 = z" using L2_def using Atom.prems(6) min.absorb2 by auto have "(∀I amount. length I = amount ⟶ (∀xs. eval (fm.Atom (Eq (b - Const B))) ([] @ xs) = eval (liftFm 0 amount (fm.Atom (Eq (b - Const B)))) ([] @ I @ xs)))" by (metis eval_liftFm_helper list.size(3)) then have "eval (Atom(Eq (b-Const B))) ([] @ L1) = eval (liftFm 0 z (Atom(Eq (b- Const B)))) ([] @ L2 @ L1)" using lengthl2 by auto then have "(insertion (nth_default 0 (L2 @ L1)) (liftPoly 0 z (b - Const B)) = 0)" apply(simp add: insertion_sub insertion_const) using h1a by auto then have "insertion (nth_default 0 (L2 @ L1)) (liftPoly 0 z b) = B" using lift_minus by blast then have h1 : "insertion (nth_default 0 (L[var + z := B/C])) (liftPoly 0 z b) = B" using not_in_lift[OF Atom(2), of z] L_def by (metis list_update_id not_contains_insertion) have h2a : "insertion (nth_default 0 L1) c = C" using not_contains_insertion[OF Atom(3), of L1 "B/C" C] Atom(5) unfolding L1_def by (metis list_update_id) have "(∀I amount. length I = amount ⟶ (∀xs. eval (fm.Atom (Eq (c - Const C))) ([] @ xs) = eval (liftFm 0 amount (fm.Atom (Eq (c - Const C)))) ([] @ I @ xs)))" by (metis eval_liftFm_helper list.size(3)) then have "eval (Atom(Eq (c-Const C))) ([] @ L1) = eval (liftFm 0 z (Atom(Eq (c- Const C)))) ([] @ L2 @ L1)" using lengthl2 by auto then have "(insertion (nth_default 0 (L2 @ L1)) (liftPoly 0 z (c - Const C)) = 0)" apply(simp add: insertion_sub insertion_const) using h2a by auto then have "insertion (nth_default 0 (L2 @ L1)) (liftPoly 0 z c) = C" using lift_minus by blast then have h2 : "insertion (nth_default 0 (L[var + z := B/C])) (liftPoly 0 z c) = C" using not_in_lift[OF Atom(3), of z] L_def by (metis list_update_id not_contains_insertion) show ?case using linear[OF Atom(6) Atom(1) not_in_lift[OF Atom(2)] not_in_lift[OF Atom(3)], of B, of x, OF h1 h2] unfolding linear_substitution_fm_helper.simps liftmap.simps eval.simps . next case (And F1 F2) then show ?case by auto next case (Or F1 F2) then show ?case using var_not_in_linear_fm_helper var_not_in_eval unfolding linear_substitution_fm_helper.simps liftmap.simps eval.simps by blast next case (Neg F) then show ?case using var_not_in_linear_fm_helper var_not_in_eval unfolding linear_substitution_fm_helper.simps liftmap.simps eval.simps by blast next case (ExQ F) have droph : "(drop (z + 1) (x#L)) = (drop z L)" for x by auto have l : "x # L[var + z := v] = ((x#L)[var+(z+1):=v])" for x v by auto have "eval (ExQ F) (L[var + z := B/C]) = (∃x. eval F ((x # L)[var + (z + 1) := B/C])) " apply(simp) unfolding l done also have "... = (∃x. eval (liftmap (λx. λa. Atom(linear_substitution (var + x) (liftPoly 0 x b) (liftPoly 0 x c) a)) F (z + 1)) ((x # L)[var + (z + 1) := v]))" apply(rule ex_cong1) using ExQ(1)[of "z+1", OF assms(1) assms(2) assms(3)] droph unfolding linear_substitution_fm_helper.simps liftmap.simps by (metis (mono_tags, lifting) ExQ.prems(4) ExQ.prems(5) ExQ.prems(6) One_nat_def Suc_eq_plus1 Suc_less_eq add_Suc_right list.size(4)) also have "... = (eval (linear_substitution_fm_helper var b c (ExQ F) z) (L[var + z := v]))" unfolding linear_substitution_fm_helper.simps liftmap.simps eval.simps l by simp finally show ?case by simp next case (AllQ F) have droph : "(drop (z + 1) (x#L)) = (drop z L)" for x by auto have l : "x # L[var + z := v] = ((x#L)[var+(z+1):=v])" for x v by auto have "eval (AllQ F) (L[var + z := B/C]) = (∀x. eval F ((x # L)[var + (z + 1) := B/C])) " apply(simp) unfolding l done also have "... = (∀x. eval (liftmap (λx.λa. Atom(linear_substitution (var + x) (liftPoly 0 x b) (liftPoly 0 x c) a)) F (z + 1)) ((x # L)[var + (z + 1) := v]))" apply(rule all_cong1) using AllQ(1)[of "z+1", OF assms(1) assms(2) assms(3)] var_not_in_linear_fm_helper[OF assms(2) assms(3)] var_not_in_eval droph unfolding linear_substitution_fm_helper.simps liftmap.simps by (metis (mono_tags, lifting) AllQ(7) AllQ.prems(4) AllQ.prems(5) One_nat_def Suc_eq_plus1 Suc_less_eq add_Suc_right list.size(4)) also have "... = (eval (linear_substitution_fm_helper var b c (AllQ F) z) (L[var + z := v]))" unfolding linear_substitution_fm_helper.simps liftmap.simps eval.simps l by auto finally show ?case by simp next case (ExN x1 φ) have list : "⋀l. length l=x1 ⟹ ((drop (z + x1) l @ drop (z + x1 - length l) L)[var := B / C]) = ((drop z L)[var := B / C])" by auto have map : "⋀ z L. eval (liftmap (λx A. fm.Atom (linear_substitution (var + x) (liftPoly 0 x b) (liftPoly 0 x c) A)) φ (z + x1)) L = eval (liftmap (λx A. fm.Atom (linear_substitution (var + x1 + x) (liftPoly 0 (x+x1) b) (liftPoly 0 (x+x1) c) A)) φ z) L" apply(induction φ) apply(simp_all add:add.commute add.left_commute) apply force apply force by (metis (mono_tags, lifting) ab_semigroup_add_class.add_ac(1))+ show ?case apply simp apply(rule ex_cong1) subgoal for l using map[of z] ExN(1)[OF ExN(2-4), of "z+x1" "l@L"] ExN(5-7) list apply simp by (smt (z3) add.commute add.left_commute add_diff_cancel_left' add_mono_thms_linordered_field(4) list list_update_append not_add_less1 order_refl) done next case (AllN x1 φ) have list : "⋀l. length l=x1 ⟹ ((drop (z + x1) l @ drop (z + x1 - length l) L)[var := B / C]) = ((drop z L)[var := B / C])" by auto have map : "⋀ z L. eval (liftmap (λx A. fm.Atom (linear_substitution (var + x) (liftPoly 0 x b) (liftPoly 0 x c) A)) φ (z + x1)) L = eval (liftmap (λx A. fm.Atom (linear_substitution (var + x1 + x) (liftPoly 0 (x+x1) b) (liftPoly 0 (x+x1) c) A)) φ z) L" apply(induction φ) apply(simp_all add:add.commute add.left_commute) apply force apply force by (metis (mono_tags, lifting) ab_semigroup_add_class.add_ac(1))+ show ?case apply simp apply(rule all_cong1) subgoal for l using map[of z] AllN(1)[OF AllN(2-4), of "z+x1" "l@L"] AllN(5-7) list apply simp by (smt (z3) add.commute add.left_commute add_diff_cancel_left' add_mono_thms_linordered_field(4) list list_update_append not_add_less1 order_refl) done qed theorem linear_fm : assumes lLength : "length L > var" assumes "C ≠ 0" assumes "var ∉ vars b" assumes "var ∉ vars c" assumes "insertion (nth_default 0 (list_update L var (B/C))) b = (B::real)" assumes "insertion (nth_default 0 (list_update L var (B/C))) c = (C::real)" shows "eval F (list_update L var (B/C)) = (∀v. eval (linear_substitution_fm var b c F) (list_update L var v))" unfolding linear_substitution_fm.simps using linear_fm_helper[OF assms(2) assms(3) assms(4), of 0 L B] assms(1) assms(5) assms(6) by (simp add: lLength) end
subsection "Quadratic Case" theory QuadraticCase imports VSAlgos begin (*-------------------------------------------------------------------------------------------------------------*) lemma quad_part_1_eq : assumes lLength : "length L > var" assumes hdeg : "MPoly_Type.degree (p::real mpoly) var = (deg::nat)" assumes nonzero : "D ≠ 0" assumes ha : "∀x. insertion (nth_default 0 (list_update L var x)) a = (A::real)" assumes hb : "∀x. insertion (nth_default 0 (list_update L var x)) b = (B::real)" assumes hd : "∀x. insertion (nth_default 0 (list_update L var x)) d = (D::real)" shows "aEval (Eq p) (list_update L var ((A+B*C)/D)) = aEval (Eq(quadratic_part_1 var a b d (Eq p))) (list_update L var C)" proof - define f where "f i = insertion (nth_default 0 (list_update L var C)) (isolate_variable_sparse p var i) * ((A + B * C) ^ i)" for i have h1 : "∀i. (insertion (nth_default 0 (list_update L var C)) (isolate_variable_sparse p var i)) = (insertion (nth_default 0 (list_update L var ((A+B*C)/D))) (isolate_variable_sparse p var i))" by(simp add: insertion_isovarspars_free) have h2 : "((∑i = 0..<deg+1. f i / D ^ i) = 0) =((∑i = 0..<deg+1. (f i) * D ^ (deg - i)) = 0)" using normalize_summation nonzero by(auto) have "aEval (Eq(quadratic_part_1 var a b d (Eq p))) (list_update L var C) = ((∑i = 0..<deg+1. (insertion (nth_default 0 (list_update L var C)) (isolate_variable_sparse p var i) * ((A + B * C) ^ i)) * D ^ (deg - i)) = 0)" by(simp add: hdeg insertion_sum insertion_add insertion_mult insertion_var insertion_pow ha hb hd lLength) also have "... =((∑i = 0..<deg+1. (insertion (nth_default 0 (list_update L var C)) (isolate_variable_sparse p var i) * ((A + B * C) ^ i)) / D ^ i) = 0)" using f_def h2 by auto also have "... =((∑i = 0..<deg+1. (insertion (nth_default 0 (list_update L var C)) (isolate_variable_sparse p var i) * ((A + B * C)^i / (D ^ i)))) = 0)" by auto also have "... =((∑i = 0..<deg+1. (insertion (nth_default 0 (list_update L var C)) (isolate_variable_sparse p var i) * ((A + B * C)/D) ^ i)) = 0)" by (metis (no_types, lifting) power_divide sum.cong) also have "... =((∑i = 0..<deg+1. (insertion (nth_default 0 (list_update L var ((A+B*C)/D))) (isolate_variable_sparse p var i) * ((A + B * C)/D) ^ i))=0)" using h1 by auto also have "... = (insertion (nth_default 0 (list_update L var ((A+B*C)/D))) p =0)" using sum_over_degree_insertion hdeg lLength by auto also have "... = aEval (Eq p) (list_update L var ((A+B*C)/D))" using aEval.simps(1) by blast finally show ?thesis using assms by auto qed (*------------------------------------------------------------------------------------------------*) lemma quad_part_1_less : assumes lLength : "length L > var" assumes hdeg : "MPoly_Type.degree (p::real mpoly) var = (deg::nat)" assumes nonzero : "D ≠ 0" assumes ha : "∀x. insertion (nth_default 0 (list_update L var x)) a = (A::real)" assumes hb : "∀x. insertion (nth_default 0 (list_update L var x)) b = (B::real)" assumes hd : "∀x. insertion (nth_default 0 (list_update L var x)) d = (D::real)" shows "aEval (Less p) (list_update L var ((A+B*C)/D)) = aEval (Less(quadratic_part_1 var a b d (Less p))) (list_update L var C)" proof - define f where "f i = insertion (nth_default 0 (list_update L var C)) (isolate_variable_sparse p var i) * ((A + B * C) ^ i)" for i have h1a : "((∑i = 0..<deg+1. f i / D ^ i) < 0) =((∑i = 0..<deg+1. (f i) * D ^ (deg - i)) * D ^ (deg mod 2) < 0)" using normalize_summation_less nonzero by(auto) have h4a : "∀i. (insertion (nth_default 0 (list_update L var C)) (isolate_variable_sparse p var i)) = (insertion (nth_default 0 (list_update L var ((A+B*C)/D))) (isolate_variable_sparse p var i))" by(simp add: insertion_isovarspars_free) have "((∑i = 0..<deg+1. (insertion (nth_default 0 (list_update L var C)) (isolate_variable_sparse p var i) * ((A + B * C) ^ i)) * D ^ (deg - i)) * D ^ (deg mod 2) < 0) =((∑i = 0..<deg+1. (insertion (nth_default 0 (list_update L var C)) (isolate_variable_sparse p var i) * ((A + B * C) ^ i)) / D ^ i) < 0)" using h1a f_def by auto also have "...=((∑i = 0..<deg+1. (insertion (nth_default 0 (list_update L var C)) (isolate_variable_sparse p var i) * ((A + B * C)^i / (D ^ i)))) < 0)" by auto also have "...=((∑i = 0..<deg+1. (insertion (nth_default 0 (list_update L var C)) (isolate_variable_sparse p var i) * ((A + B * C)/D) ^ i)) < 0)" by (metis (no_types, lifting) power_divide sum.cong) also have "... =((∑i = 0..<deg+1. (insertion (nth_default 0 (list_update L var ((A+B*C)/D))) (isolate_variable_sparse p var i) * ((A + B * C)/D) ^ i))<0)" using h4a by auto also have "... = (insertion (nth_default 0 (list_update L var ((A+B*C)/D))) p <0)" using sum_over_degree_insertion hdeg lLength by auto finally show ?thesis by(simp add: hdeg lLength insertion_add insertion_mult ha hb hd insertion_sum insertion_pow insertion_var) qed (*------------------------------------------------------------------------------------------------*) lemma quad_part_1_leq : assumes lLength : "length L > var" assumes hdeg : "MPoly_Type.degree (p::real mpoly) var = (deg::nat)" assumes nonzero : "D ≠ 0" assumes ha : "∀x. insertion (nth_default 0 (list_update L var x)) a = (A::real)" assumes hb : "∀x. insertion (nth_default 0 (list_update L var x)) b = (B::real)" assumes hd : "∀x. insertion (nth_default 0 (list_update L var x)) d = (D::real)" shows "aEval (Leq p) (list_update L var ((A+B*C)/D)) = aEval (Leq(quadratic_part_1 var a b d (Leq p))) (list_update L var C)" proof - define f where "f i = insertion (nth_default 0 (list_update L var C)) (isolate_variable_sparse p var i) * ((A + B * C) ^ i)" for i have h1a : "((∑i = 0..<deg+1. f i / D ^ i) < 0) =((∑i = 0..<deg+1. (f i) * D ^ (deg - i)) * D ^ (deg mod 2) < 0)" using normalize_summation_less nonzero by(auto) have h1b : "((∑i = 0..<deg+1. f i / D ^ i) = 0) =((∑i = 0..<deg+1. (f i) * D ^ (deg - i)) = 0)" using normalize_summation nonzero by(auto) have h1c : "((∑i = 0..<deg+1. f i / D ^ i) ≤ 0) =((∑i = 0..<deg+1. (f i) * D ^ (deg - i)) * D ^ (deg mod 2) ≤ 0)" using h1a h1b nonzero by auto have h4a : "∀i. (insertion (nth_default 0 (list_update L var C)) (isolate_variable_sparse p var i)) = (insertion (nth_default 0 (list_update L var ((A+B*C)/D))) (isolate_variable_sparse p var i))" by(simp add: insertion_isovarspars_free) have "((∑i = 0..<deg+1. (insertion (nth_default 0 (list_update L var C)) (isolate_variable_sparse p var i) * ((A + B * C) ^ i)) * D ^ (deg - i)) * D ^ (deg mod 2) ≤ 0)= ((∑i = 0..<deg+1. (insertion (nth_default 0 (list_update L var C)) (isolate_variable_sparse p var i) * ((A + B * C) ^ i)) / D ^ i) ≤ 0)" using h1c f_def by auto also have "...=((∑i = 0..<deg+1. (insertion (nth_default 0 (list_update L var C)) (isolate_variable_sparse p var i) * ((A + B * C)^i / (D ^ i)))) ≤ 0)" by auto also have "...=((∑i = 0..<deg+1. (insertion (nth_default 0 (list_update L var C)) (isolate_variable_sparse p var i) * ((A + B * C)/D) ^ i)) ≤ 0)" by (metis (no_types, lifting) power_divide sum.cong) also have "...=((∑i = 0..<deg+1. (insertion (nth_default 0 (list_update L var ((A+B*C)/D))) (isolate_variable_sparse p var i) * ((A + B * C)/D) ^ i))≤0)" using h4a by auto also have "... = (insertion (nth_default 0 (list_update L var ((A+B*C)/D))) p≤0)" using sum_over_degree_insertion hdeg lLength by auto finally show ?thesis by(simp add: hdeg lLength insertion_add insertion_mult ha hb hd insertion_sum insertion_pow insertion_var) qed (*------------------------------------------------------------------------------------------------*) lemma quad_part_1_neq : assumes lLength : "length L > var" assumes hdeg : "MPoly_Type.degree (p::real mpoly) var = (deg::nat)" assumes nonzero : "D ≠ 0" assumes ha : "∀x. insertion (nth_default 0 (list_update L var x)) a = (A::real)" assumes hb : "∀x. insertion (nth_default 0 (list_update L var x)) b = (B::real)" assumes hd : "∀x. insertion (nth_default 0 (list_update L var x)) d = (D::real)" shows "aEval (Neq p) (list_update L var ((A+B*C)/D)) = aEval (Neq(quadratic_part_1 var a b d (Neq p))) (list_update L var C)" proof - have "aEval (Eq(quadratic_part_1 var a b d (Eq p))) (list_update L var C) = aEval (Eq p) (list_update L var ((A+B*C)/D))" using quad_part_1_eq assms by blast then show ?thesis by auto qed (*------------------------------------------------------------------------------------------------*) lemma sqrt_case : assumes detGreater0 : "SQ ≥ 0" shows "((SQ^(i div 2)) * real (i mod 2) * sqrt SQ + SQ ^ (i div 2) * (1 - real (i mod 2))) = (sqrt SQ) ^ i" proof - have h1 : "i mod 2 = 0 ∨ (odd i ∧ (i mod 2 = 1))" by auto have h2 : "i mod 2 = 0 ⟹ ((SQ^(i div 2)) * real (i mod 2) * sqrt SQ + SQ ^ (i div 2) * (1 - real (i mod 2))) = (sqrt SQ) ^ i" using detGreater0 apply auto by (simp add: real_sqrt_power_even) have h3 : "(odd i ∧ (i mod 2 = 1)) ⟹ ((SQ^(i div 2)) * real (i mod 2) * sqrt SQ + SQ ^ (i div 2) * (1 - real (i mod 2))) = (sqrt SQ) ^ i" using detGreater0 apply auto by (smt One_nat_def add_Suc_right mult.commute nat_arith.rule0 odd_two_times_div_two_succ power.simps(2) power_mult real_sqrt_pow2) show ?thesis using h1 h2 h3 by linarith qed lemma sum_over_sqrt : assumes detGreater0 : "SQ ≥ 0" shows "(∑i∈{0..<n+1}. ((f i::real) * (SQ^(i div 2)) * real (i mod 2) * sqrt SQ +f i * SQ ^ (i div 2) * (1 - real (i mod 2)))) =(∑i∈{0..<n+1}. ((f i::real) * ((sqrt SQ)^i)))" using sqrt_case detGreater0 by (metis (no_types, hide_lams) distrib_left mult.assoc) lemma quad_part_2_eq : assumes lLength : "length L > var" assumes detGreater0 : "SQ≥0" assumes hdeg : "MPoly_Type.degree (p::real mpoly) var = (deg ::nat)" assumes hsq : "∀x. insertion (nth_default 0 (list_update L var x)) sq = (SQ::real)" shows "aEval (Eq p) (list_update L var (sqrt SQ)) = aEval (Eq(quadratic_part_2 var sq p)) (list_update L var (sqrt SQ))" proof - define f where "f i = insertion (nth_default 0 (list_update L var (sqrt SQ))) (isolate_variable_sparse p var i)" for i have h1a : "(∑i∈{0..<deg+1}. (f i * (SQ^(i div 2)) * real (i mod 2) * sqrt SQ +f i * SQ ^ (i div 2) * (1 - real (i mod 2)))) =(∑i∈{0..<deg+1}. (f i * ((sqrt SQ)^i)))" using sum_over_sqrt detGreater0 by auto have "(∑i∈{0..<deg+1}. (insertion (nth_default 0 (list_update L var (sqrt SQ))) (isolate_variable_sparse p var i) * (SQ^(i div 2)) * real (i mod 2) * sqrt SQ + (insertion (nth_default 0 (list_update L var (sqrt SQ))) (isolate_variable_sparse p var i)) * SQ ^ (i div 2) * (1 - real (i mod 2)))) =(∑i∈{0..<deg+1}. (insertion (nth_default 0 (list_update L var (sqrt SQ))) (isolate_variable_sparse p var i) * ((sqrt SQ)^i)))" using h1a f_def by auto also have "... = insertion (nth_default 0 (list_update L var (sqrt SQ))) p" using sum_over_degree_insertion hdeg lLength by auto finally show ?thesis by(simp add:hdeg hsq insertion_add insertion_sum insertion_mult insertion_pow insertion_var insertion_const lLength) qed lemma quad_part_2_less : assumes lLength : "length L > var" assumes detGreater0 : "SQ≥0" assumes hdeg : "MPoly_Type.degree (p::real mpoly) var = (deg ::nat)" assumes hsq : "∀x. insertion (nth_default 0 (list_update L var x)) sq = (SQ::real)" shows "aEval (Less p) (list_update L var (sqrt SQ)) = aEval (Less(quadratic_part_2 var sq p)) (list_update L var (sqrt SQ))" proof - define f where "f i = insertion (nth_default 0 (list_update L var (sqrt SQ))) (isolate_variable_sparse p var i)" for i have h1a : "(∑i∈{0..<deg+1}. (f i * (SQ^(i div 2)) * real (i mod 2) * sqrt SQ +f i * SQ ^ (i div 2) * (1 - real (i mod 2)))) =(∑i∈{0..<deg+1}. (f i * ((sqrt SQ)^i)))" using sum_over_sqrt detGreater0 by auto have "(∑i∈{0..<deg+1}. (insertion (nth_default 0 (list_update L var (sqrt SQ))) (isolate_variable_sparse p var i) * (SQ^(i div 2)) * real (i mod 2) * sqrt SQ + (insertion (nth_default 0 (list_update L var (sqrt SQ))) (isolate_variable_sparse p var i)) * SQ ^ (i div 2) * (1 - real (i mod 2)))) =(∑i∈{0..<deg+1}. (insertion (nth_default 0 (list_update L var (sqrt SQ))) (isolate_variable_sparse p var i) * ((sqrt SQ)^i)))" using h1a f_def by auto also have "... = insertion (nth_default 0 (list_update L var (sqrt SQ))) p" using sum_over_degree_insertion hdeg lLength by auto finally show ?thesis by(simp add:hdeg hsq insertion_add insertion_sum insertion_mult insertion_pow insertion_var insertion_const lLength) qed lemma quad_part_2_neq : assumes lLength : "length L > var" assumes detGreater0 : "SQ≥0" assumes hdeg : "MPoly_Type.degree (p::real mpoly) var = (deg ::nat)" assumes hsq : "∀x. insertion (nth_default 0 (list_update L var x)) sq = (SQ::real)" shows "aEval (Neq p) (list_update L var (sqrt SQ)) = aEval (Neq(quadratic_part_2 var sq p)) (list_update L var (sqrt SQ))" proof - define f where "f i = insertion (nth_default 0 (list_update L var (sqrt SQ))) (isolate_variable_sparse p var i)" for i have h1a : "(∑i∈{0..<deg+1}. (f i * (SQ^(i div 2)) * real (i mod 2) * sqrt SQ +f i * SQ ^ (i div 2) * (1 - real (i mod 2)))) =(∑i∈{0..<deg+1}. (f i * ((sqrt SQ)^i)))" using sum_over_sqrt detGreater0 by auto have "(∑i∈{0..<deg+1}. (insertion (nth_default 0 (list_update L var (sqrt SQ))) (isolate_variable_sparse p var i) * (SQ^(i div 2)) * real (i mod 2) * sqrt SQ + (insertion (nth_default 0 (list_update L var (sqrt SQ))) (isolate_variable_sparse p var i)) * SQ ^ (i div 2) * (1 - real (i mod 2)))) =(∑i∈{0..<deg+1}. (insertion (nth_default 0 (list_update L var (sqrt SQ))) (isolate_variable_sparse p var i) * ((sqrt SQ)^i)))" using h1a f_def by auto also have "... = insertion (nth_default 0 (list_update L var (sqrt SQ))) p" using sum_over_degree_insertion hdeg lLength by auto finally show ?thesis by(simp add:hdeg hsq insertion_add insertion_sum insertion_mult insertion_pow insertion_var insertion_const lLength) qed lemma quad_part_2_leq : assumes lLength : "length L > var" assumes detGreater0 : "SQ≥0" assumes hdeg : "MPoly_Type.degree (p::real mpoly) var = (deg ::nat)" assumes hsq : "∀x. insertion (nth_default 0 (list_update L var x)) sq = (SQ::real)" shows "aEval (Leq p) (list_update L var (sqrt SQ)) = aEval (Leq(quadratic_part_2 var sq p)) (list_update L var (sqrt SQ))" proof - define f where "f i = insertion (nth_default 0 (list_update L var (sqrt SQ))) (isolate_variable_sparse p var i)" for i have h1a : "(∑i∈{0..<deg+1}. (f i * (SQ^(i div 2)) * real (i mod 2) * sqrt SQ +f i * SQ ^ (i div 2) * (1 - real (i mod 2)))) =(∑i∈{0..<deg+1}. (f i * ((sqrt SQ)^i)))" using sum_over_sqrt detGreater0 by auto have "(∑i∈{0..<deg+1}. (insertion (nth_default 0 (list_update L var (sqrt SQ))) (isolate_variable_sparse p var i) * (SQ^(i div 2)) * real (i mod 2) * sqrt SQ + (insertion (nth_default 0 (list_update L var (sqrt SQ))) (isolate_variable_sparse p var i)) * SQ ^ (i div 2) * (1 - real (i mod 2)))) =(∑i∈{0..<deg+1}. (insertion (nth_default 0 (list_update L var (sqrt SQ))) (isolate_variable_sparse p var i) * ((sqrt SQ)^i)))" using h1a f_def by auto also have "... = insertion (nth_default 0 (list_update L var (sqrt SQ))) p" using sum_over_degree_insertion hdeg lLength by auto finally show ?thesis by(simp add:hdeg hsq insertion_add insertion_sum insertion_mult insertion_pow insertion_var insertion_const lLength) qed lemma quad_part_2_deg : assumes sqfree : "(var::nat)∉vars(sq::real mpoly)" shows "MPoly_Type.degree (quadratic_part_2 var sq p) var ≤ 1" proof - define deg where "deg = MPoly_Type.degree (p::real mpoly) var" define f where "f i = isolate_variable_sparse p var i * sq ^ (i div 2) * Const (real (i mod 2)) * Var var" for i define g where "g i = isolate_variable_sparse p var i * sq ^ (i div 2) * Const (1 - real (i mod 2))" for i have h1a : "∀i. MPoly_Type.degree (isolate_variable_sparse p var i) var = 0" by (simp add: varNotIn_degree not_in_isovarspar) have h1b : "∀i. MPoly_Type.degree (sq ^ (i div 2)) var = 0" by (simp add: sqfree varNotIn_degree not_in_pow) have h1c : "∀i. MPoly_Type.degree (Const (real (i mod 2))) var = 0" using degree_const by blast have h1d : "MPoly_Type.degree (Var var :: real mpoly) var = 1" using degree_one by auto have h1 : "∀i<deg+1. MPoly_Type.degree (f i) var ≤ 1" using f_def degree_mult h1a h1b h1c h1d by (smt ExecutiblePolyProps.degree_one add.right_neutral mult.commute mult_eq_0_iff nat_le_linear not_one_le_zero) have h2a : "∀i. MPoly_Type.degree (Const (1 - real (i mod 2))) var = 0" using degree_const by blast have h2 : "∀i<deg+1. MPoly_Type.degree (g i) var = 0" using g_def degree_mult h1a h1b h2a by (metis (no_types, lifting) add.right_neutral mult_eq_0_iff) have h3 : "∀i<deg+1. MPoly_Type.degree (f i + g i) var ≤ 1" using h1 h2 by (simp add: degree_add_leq) show ?thesis using atLeastLessThanSuc_atLeastAtMost degree_sum f_def g_def h3 deg_def by auto qed (*------------------------------------------------------------------------------------------------*) lemma quad_equality_helper : assumes lLength : "length L > var" assumes detGreat0 : "Cv≥0" assumes hC : "∀x. insertion (nth_default 0 (list_update L var x)) (C::real mpoly) = (Cv::real)" assumes hA : "∀x. insertion (nth_default 0 (list_update L var x)) (A::real mpoly) = (Av::real)" assumes hB : "∀x. insertion (nth_default 0 (list_update L var x)) (B::real mpoly) = (Bv::real)" shows "aEval (Eq (A + B * Var var)) (list_update L var (sqrt Cv)) = eval (And (Atom(Leq (A*B))) (Atom (Eq (A^2-B^2*C)))) (list_update L var (sqrt Cv))" proof- have h1 : "∀x. insertion (nth_default 0 (list_update L var x)) (A^2-(B^2)*C) = Av^2-(Bv^2)*Cv" by(simp add: hA hB hC insertion_add insertion_mult insertion_sub insertion_pow) have h2a : "(Av + Bv * sqrt Cv = 0) = (Av = - Bv * sqrt Cv)" by auto have h2b : "(Av = - Bv * sqrt Cv) ⟹ (Av^2 = (- Bv * sqrt Cv)^2)" by simp have h2c : "(Av^2 = (- Bv * sqrt Cv)^2) = (Av^2 = Bv^2 * (sqrt Cv)^2)" by (simp add: power_mult_distrib) have h2d : "(Av^2 = Bv^2 * (sqrt Cv)^2) = (Av^2 = Bv^2 * Cv)" by (simp add: detGreat0) have h2 : "(Av + Bv * sqrt Cv = 0) ⟹ (Av^2 = Bv^2 * Cv)" using h2a h2b h2c h2d by blast have h3a : "(Av*Bv > 0) ⟹ (Av + Bv * sqrt Cv ≠ 0)" by (smt detGreat0 mult_nonneg_nonneg real_sqrt_ge_zero zero_less_mult_iff) have h3 : "(Av + Bv * sqrt Cv = 0) ⟹ (Av*Bv≤ 0)" using h3a by linarith have h4 : "(Av * Bv ≤ 0 ∧ Av⇧2 = Bv⇧2 * Cv) ⟹ (Av + Bv * sqrt Cv = 0)" apply(cases "Av>0") apply (metis detGreat0 h2a h2c h2d mult_minus_left not_le power2_eq_iff real_sqrt_lt_0_iff zero_less_mult_iff) by (smt h2a real_sqrt_abs real_sqrt_mult zero_less_mult_iff) show ?thesis apply(simp add: hA hB h1 insertion_add insertion_mult insertion_var lLength) using h2 h3 h4 by blast qed lemma quadratic_sub_eq : assumes lLength : "length L > var" assumes nonzero : "Dv ≠ 0" assumes detGreater0 : "Cv ≥ 0" assumes freeC : "var ∉ vars c" assumes ha : "∀x. insertion (nth_default 0 (list_update L var x)) (a::real mpoly) = (Av :: real)" assumes hb : "∀x. insertion (nth_default 0 (list_update L var x)) (b::real mpoly) = (Bv :: real)" assumes hc : "∀x. insertion (nth_default 0 (list_update L var x)) (c::real mpoly) = (Cv :: real)" assumes hd : "∀x. insertion (nth_default 0 (list_update L var x)) (d::real mpoly) = (Dv :: real)" shows "aEval (Eq p) (list_update L var ((Av+Bv*sqrt(Cv))/Dv)) = eval (quadratic_sub var a b c d (Eq p)) (list_update L var (sqrt Cv))" proof - define p1 where "(p1::real mpoly) = quadratic_part_1 var a b d (Eq p)" define p2 where "(p2::real mpoly) = quadratic_part_2 var c p1" define A where "A = isolate_variable_sparse p2 var 0" define B where "B = isolate_variable_sparse p2 var 1" have h3c : "MPoly_Type.degree p2 var = 0 ∨ MPoly_Type.degree p2 var = 1" using freeC quad_part_2_deg p2_def by (meson le_neq_implies_less less_one) have h3d : "MPoly_Type.degree p2 var = 0 ⟹ B = 0" by(simp add: B_def isovar_greater_degree) then have h3f : "MPoly_Type.degree p2 var = 0 ⟹ p2 = A + B * Var var" by(simp add: h3d A_def degree0isovarspar) have h3g1 : "MPoly_Type.degree p2 var = 1 ⟹ p2 = (∑i≤1. isolate_variable_sparse p2 var i * Var var ^ i)" using sum_over_zero by metis have h3g2a : "∀f. (∑i::nat≤1. f i) = f 0 + f 1" by simp have h3g2 : "(∑i::nat≤1. isolate_variable_sparse p2 var i * Var var ^ i) = isolate_variable_sparse p2 var 0 * Var var ^ 0 + isolate_variable_sparse p2 var 1 * Var var ^ 1" using h3g2a by blast have h3g : "MPoly_Type.degree p2 var = 1 ⟹ p2 = A + B * Var var" apply(simp add: sum_over_zero A_def B_def) using h3g1 h3g2 by (metis (no_types, lifting) One_nat_def mult_cancel_left2 power_0 power_one_right) have h3h : "p2 = A + B * Var var" using h3c h3f h3g by auto have h4a : "∃x::real. ∀y::real. insertion (nth_default 0 (list_update L var y)) A = x" using not_contains_insertion not_in_isovarspar A_def by blast have h4b : "∃x::real. ∀y::real. insertion (nth_default 0 (list_update L var y)) B = x" using not_contains_insertion not_in_isovarspar B_def by blast have "aEval (Eq p) (list_update L var ((Av+Bv*sqrt(Cv))/Dv)) = aEval (Eq p1) (list_update L var (sqrt Cv))" using p1_def quad_part_1_eq nonzero ha hb hd lLength by blast also have h2 : "... = aEval (Eq p2) (list_update L var (sqrt Cv))" using p2_def quad_part_2_eq lLength detGreater0 hc by metis also have "... = aEval (Eq (A + B * Var var)) (list_update L var (sqrt Cv))" using h3h by auto also have "... = eval (And (Atom(Leq (A*B))) (Atom (Eq (A^2-B^2*c)))) (list_update L var (sqrt Cv))" using quad_equality_helper hc detGreater0 h4a h4b lLength by blast also have "... = eval (quadratic_sub var a b c d (Eq p)) (list_update L var (sqrt Cv))" using p2_def A_def B_def p1_def quadratic_sub.simps(1) by metis finally show ?thesis by blast qed (*------------------------------------------------------------------------------------------------*) lemma quadratic_sub_less_helper : assumes lLength : "length L > var" assumes detGreat0 : "Cv≥0" assumes hC : "∀x. insertion (nth_default 0 (list_update L var x)) (C::real mpoly) = (Cv::real)" assumes hA : "∀x. insertion (nth_default 0 (list_update L var x)) (A::real mpoly) = (Av::real)" assumes hB : "∀x. insertion (nth_default 0 (list_update L var x)) (B::real mpoly) = (Bv::real)" shows "aEval (Less (A + B * Var var)) (list_update L var (sqrt Cv)) = eval (Or (And (fm.Atom (Less A)) (fm.Atom (Less (B⇧2 * C - A⇧2)))) (And (fm.Atom (Leq B)) (Or (fm.Atom (Less A)) (fm.Atom (Less (A⇧2 - B⇧2 * C)))))) (list_update L var (sqrt Cv)) " proof- have h1 : "∀x. insertion (nth_default 0 (list_update L var x)) (A^2-(B^2)*C) = Av^2-(Bv^2)*Cv" by(simp add: hA hB hC insertion_add insertion_mult insertion_sub insertion_pow) have h2 : "∀x. insertion (nth_default 0 (list_update L var x)) ((B^2)*C-A^2) = (Bv^2)*Cv-Av^2" by(simp add: hA hB hC insertion_add insertion_mult insertion_sub insertion_pow) have h3 : "Av=0 ⟹ Bv=0 ⟹ (Av + Bv * sqrt Cv < 0) = (Av < 0 ∧ Bv⇧2 * Cv < Av⇧2 ∨ Bv ≤ 0 ∧ (Av < 0 ∨ Av⇧2 < Bv⇧2 * Cv))" by simp have h4 : "Av<0 ⟹ Bv≤0 ⟹ (Av + Bv * sqrt Cv < 0) = (Av < 0 ∧ Bv⇧2 * Cv < Av⇧2 ∨ Bv ≤ 0 ∧ (Av < 0 ∨ Av⇧2 < Bv⇧2 * Cv))" by (metis add.right_neutral add_mono_thms_linordered_field(5) detGreat0 less_eq_real_def mult_less_0_iff mult_zero_class.mult_zero_left mult_zero_class.mult_zero_right real_sqrt_eq_zero_cancel_iff real_sqrt_gt_0_iff) have h5a : "Av≥0 ⟹ Bv≤0 ⟹ (Av < -Bv * sqrt Cv) ⟹ (Av⇧2 < Bv⇧2 * Cv)" proof - assume a1: "0 ≤ Av" assume a2: "Av < - Bv * sqrt Cv" assume "Bv ≤ 0" then have "Av < sqrt (Cv * (Bv * Bv))" using a2 by (simp add: mult.commute real_sqrt_mult) then show ?thesis using a1 by (metis (no_types) mult.commute power2_eq_square real_sqrt_less_iff real_sqrt_mult real_sqrt_pow2_iff) qed have h5b : "Av≥0 ⟹ Bv≤0 ⟹ (Av⇧2 < Bv⇧2 * Cv) ⟹ (Av < -Bv * sqrt Cv)" using real_less_rsqrt real_sqrt_mult by fastforce have h5 : "Av≥0 ⟹ Bv≤0 ⟹ (Av + Bv * sqrt Cv < 0) = (Av < 0 ∧ Bv⇧2 * Cv < Av⇧2 ∨ Bv ≤ 0 ∧ (Av < 0 ∨ Av⇧2 < Bv⇧2 * Cv))" using h5a h5b by linarith have h6 : "Av≥0 ⟹ Bv>0 ⟹ (Av + Bv * sqrt Cv < 0) = (Av < 0 ∧ Bv⇧2 * Cv < Av⇧2 ∨ Bv ≤ 0 ∧ (Av < 0 ∨ Av⇧2 < Bv⇧2 * Cv))" by (smt detGreat0 mult_nonneg_nonneg real_sqrt_ge_zero) have h7a : "Av<0 ⟹ Bv>0 ⟹ (Av < -Bv * sqrt Cv) ⟹ (Bv⇧2 * Cv < Av⇧2)" by (smt mult_minus_left real_sqrt_abs real_sqrt_le_mono real_sqrt_mult) have h7b : "Av<0 ⟹ Bv>0 ⟹ (Bv⇧2 * Cv < Av⇧2) ⟹ (Av < -Bv * sqrt Cv)" by (metis abs_of_nonneg abs_real_def add.commute less_eq_real_def mult.assoc mult_minus_left power2_eq_square real_add_less_0_iff real_sqrt_less_iff real_sqrt_mult real_sqrt_mult_self) have h7 : "Av<0 ⟹ Bv>0 ⟹ (Av + Bv * sqrt Cv < 0) = (Av < 0 ∧ Bv⇧2 * Cv < Av⇧2 ∨ Bv ≤ 0 ∧ (Av < 0 ∨ Av⇧2 < Bv⇧2 * Cv))" using h7a h7b by linarith show ?thesis apply(simp add: hA hB h1 h2 insertion_add insertion_mult insertion_var lLength) using h3 h4 h5 h6 h7 by smt qed lemma quadratic_sub_less : assumes lLength : "length L > var" assumes nonzero : "Dv ≠ 0" assumes detGreater0 : "Cv ≥ 0" assumes freeC : "var ∉ vars c" assumes ha : "∀x. insertion (nth_default 0 (list_update L var x)) (a::real mpoly) = (Av :: real)" assumes hb : "∀x. insertion (nth_default 0 (list_update L var x)) (b::real mpoly) = (Bv :: real)" assumes hc : "∀x. insertion (nth_default 0 (list_update L var x)) (c::real mpoly) = (Cv :: real)" assumes hd : "∀x. insertion (nth_default 0 (list_update L var x)) (d::real mpoly) = (Dv :: real)" shows "aEval (Less p) (list_update L var ((Av+Bv*sqrt(Cv))/Dv)) = eval (quadratic_sub var a b c d (Less p)) (list_update L var (sqrt Cv))" proof - define p1 where "(p1::real mpoly) = quadratic_part_1 var a b d (Less p)" define p2 where "(p2::real mpoly) = quadratic_part_2 var c p1" define A where "A = isolate_variable_sparse p2 var 0" define B where "B = isolate_variable_sparse p2 var 1" have h3b : "MPoly_Type.degree p2 var ≤ 1" using freeC quad_part_2_deg p2_def by blast then have h3c : "MPoly_Type.degree p2 var = 0 ∨ MPoly_Type.degree p2 var = 1" by auto have h3d : "MPoly_Type.degree p2 var = 0 ⟹ B = 0" by(simp add: B_def isovar_greater_degree) then have h3f : "MPoly_Type.degree p2 var = 0 ⟹ p2 = A + B * Var var" by(simp add: h3d A_def degree0isovarspar) have h3g1 : "MPoly_Type.degree p2 var = 1 ⟹ p2 = (∑i≤1. isolate_variable_sparse p2 var i * Var var ^ i)" using sum_over_zero by metis have h3g2a : "∀f. (∑i::nat≤1. f i) = f 0 + f 1" by simp have h3g2 : "(∑i::nat≤1. isolate_variable_sparse p2 var i * Var var ^ i) = isolate_variable_sparse p2 var 0 * Var var ^ 0 + isolate_variable_sparse p2 var 1 * Var var ^ 1" using h3g2a by blast have h3g : "MPoly_Type.degree p2 var = 1 ⟹ p2 = A + B * Var var" apply(simp add: sum_over_zero A_def B_def) using h3g1 h3g2 by (metis (no_types, lifting) One_nat_def mult_cancel_left2 power_0 power_one_right) have h3h : "p2 = A + B * Var var" using h3c h3f h3g by auto have h4a : "∃x::real. ∀y::real. insertion (nth_default 0(list_update L var y)) A = x" using not_contains_insertion not_in_isovarspar A_def by blast have h4b : "∃x::real. ∀y::real. insertion (nth_default 0(list_update L var y)) B = x" using not_contains_insertion not_in_isovarspar B_def by blast have h1 : "aEval (Less p) (list_update L var ((Av+Bv*sqrt(Cv))/Dv)) = aEval (Less (quadratic_part_1 var a b d (Less p))) (list_update L var (sqrt Cv))" using quad_part_1_less assms by blast also have "... = aEval (Less p1) (list_update L var (sqrt Cv))" using p1_def by auto also have "... = aEval (Less (quadratic_part_2 var c p1)) (list_update L var (sqrt Cv))" using quad_part_2_less assms by blast also have "... = aEval (Less p2) (list_update L var (sqrt Cv))" using p2_def by auto also have "... = aEval (Less (A + B * Var var)) (list_update L var (sqrt Cv))" using h3h by auto also have "... = eval (Or (And (fm.Atom (Less A)) (fm.Atom (Less (B⇧2 * c - A⇧2)))) (And (fm.Atom (Leq B)) (Or (fm.Atom (Less A)) (fm.Atom (Less (A⇧2 - B⇧2 * c)))))) (list_update L var (sqrt Cv))" using quadratic_sub_less_helper hc detGreater0 h4a h4b lLength by blast also have "... = eval (quadratic_sub var a b c d (Less p)) (list_update L var (sqrt Cv))" using p2_def A_def B_def p1_def quadratic_sub.simps(2) by metis finally show ?thesis by blast qed (*------------------------------------------------------------------------------------------------*) lemma quadratic_sub_leq_helper : assumes lLength : "length L > var" assumes detGreat0 : "Cv≥0" assumes hC : "∀x. insertion (nth_default 0 (list_update L var x)) (C::real mpoly) = (Cv::real)" assumes hA : "∀x. insertion (nth_default 0 (list_update L var x)) (A::real mpoly) = (Av::real)" assumes hB : "∀x. insertion (nth_default 0 (list_update L var x)) (B::real mpoly) = (Bv::real)" shows "aEval (Leq (A + B * Var var)) (list_update L var (sqrt Cv)) = eval (Or(And(Atom(Leq(A)))(Atom (Leq(B^2*C-A^2))))(And (Atom(Leq B)) (Atom(Leq (A^2-B^2*C))))) (list_update L var (sqrt Cv))" proof- have h1 : "∀x. insertion (nth_default 0 (list_update L var x)) (A^2-(B^2)*C) = Av^2-(Bv^2)*Cv" by(simp add: hA hB hC insertion_add insertion_mult insertion_sub insertion_pow) have h2 : "∀x. insertion (nth_default 0 (list_update L var x)) ((B^2)*C-A^2) = (Bv^2)*Cv-Av^2" by(simp add: hA hB hC insertion_add insertion_mult insertion_sub insertion_pow) have h3 : "Av=0 ⟹ Bv=0 ⟹ (Av + Bv * sqrt Cv ≤ 0) = (Av ≤ 0 ∧ Bv⇧2 * Cv ≤ Av⇧2 ∨ Bv ≤ 0 ∧ Av⇧2 ≤ Bv⇧2 * Cv)" by simp have h4 : "Av<0 ⟹ Bv≤0 ⟹ (Av + Bv * sqrt Cv ≤ 0) = (Av ≤ 0 ∧ Bv⇧2 * Cv ≤ Av⇧2 ∨ Bv ≤ 0 ∧ Av⇧2 ≤ Bv⇧2 * Cv)" by (smt detGreat0 real_sqrt_ge_zero zero_less_mult_iff) have h5 : "Av=0 ⟹ Bv≤0 ⟹ (Av + Bv * sqrt Cv ≤ 0) = (Av ≤ 0 ∧ Bv⇧2 * Cv ≤ Av⇧2 ∨ Bv ≤ 0 ∧ Av⇧2 ≤ Bv⇧2 * Cv)" by (smt detGreat0 real_sqrt_ge_zero zero_less_mult_iff) have h6 : "Av≥0 ⟹ Bv>0 ⟹ (Av + Bv * sqrt Cv ≤ 0) = (Av ≤ 0 ∧ Bv⇧2 * Cv ≤ Av⇧2 ∨ Bv ≤ 0 ∧ Av⇧2 ≤ Bv⇧2 * Cv)" by (smt detGreat0 mult_nonneg_nonneg mult_pos_pos real_sqrt_gt_0_iff real_sqrt_zero zero_le_power2 zero_less_mult_pos zero_less_power2) have h7a : "Av<0 ⟹ Bv>0 ⟹ (Av + Bv * sqrt Cv ≤ 0) ⟹ Bv⇧2 * Cv ≤ Av⇧2" by (smt real_sqrt_abs real_sqrt_less_mono real_sqrt_mult) have h7b : "Av<0 ⟹ Bv>0 ⟹ Bv⇧2 * Cv ≤ Av⇧2 ⟹ (Av + Bv * sqrt Cv ≤ 0) " by (smt real_sqrt_abs real_sqrt_less_mono real_sqrt_mult) have h7 : "Av<0 ⟹ Bv>0 ⟹ (Av + Bv * sqrt Cv ≤ 0) = (Av ≤ 0 ∧ Bv⇧2 * Cv ≤ Av⇧2 ∨ Bv ≤ 0 ∧ Av⇧2 ≤ Bv⇧2 * Cv)" using h7a h7b by linarith have h8c : "(-Bv * sqrt Cv)^2 = Bv⇧2 * Cv" by (simp add: detGreat0 power_mult_distrib) have h8a : "Av>0 ⟹ Bv≤0 ⟹ (Av ≤ -Bv * sqrt Cv) ⟹ Av⇧2 ≤ Bv⇧2 * Cv" using detGreat0 h8c power_both_sides by smt have h8b : "Av>0 ⟹ Bv≤0 ⟹ Av⇧2 ≤ Bv⇧2 * Cv ⟹ (Av + Bv * sqrt Cv ≤ 0) " using detGreat0 h8c power_both_sides by (smt mult_minus_left real_sqrt_ge_zero zero_less_mult_iff) have h8 : "Av>0 ⟹ Bv≤0 ⟹ (Av + Bv * sqrt Cv ≤ 0) = (Av ≤ 0 ∧ Bv⇧2 * Cv ≤ Av⇧2 ∨ Bv ≤ 0 ∧ Av⇧2 ≤ Bv⇧2 * Cv)" using h8a h8b by linarith show ?thesis apply(simp add: hA hB h1 h2 insertion_add insertion_mult insertion_var lLength) using h3 h4 h5 h6 h7 h8 by smt qed lemma quadratic_sub_leq : assumes lLength : "length L > var" assumes nonzero : "Dv ≠ 0" assumes detGreater0 : "Cv ≥ 0" assumes freeC : "var ∉ vars c" assumes ha : "∀x. insertion (nth_default 0 (list_update L var x)) (a::real mpoly) = (Av :: real)" assumes hb : "∀x. insertion (nth_default 0 (list_update L var x)) (b::real mpoly) = (Bv :: real)" assumes hc : "∀x. insertion (nth_default 0 (list_update L var x)) (c::real mpoly) = (Cv :: real)" assumes hd : "∀x. insertion (nth_default 0 (list_update L var x)) (d::real mpoly) = (Dv :: real)" shows "aEval (Leq p) (list_update L var ((Av+Bv*sqrt(Cv))/Dv)) = eval (quadratic_sub var a b c d (Leq p)) (list_update L var (sqrt Cv))" proof - define p1 where "(p1::real mpoly) = quadratic_part_1 var a b d (Leq p)" define p2 where "(p2::real mpoly) = quadratic_part_2 var c p1" define A where "A = isolate_variable_sparse p2 var 0" define B where "B = isolate_variable_sparse p2 var 1" have h3b : "MPoly_Type.degree p2 var ≤ 1" using freeC quad_part_2_deg p2_def lLength by metis then have h3c : "MPoly_Type.degree p2 var = 0 ∨ MPoly_Type.degree p2 var = 1" by auto have h3d : "MPoly_Type.degree p2 var = 0 ⟹ B = 0" by(simp add: B_def isovar_greater_degree) then have h3f : "MPoly_Type.degree p2 var = 0 ⟹ p2 = A + B * Var var" by(simp add: h3d A_def degree0isovarspar) have h3g1 : "MPoly_Type.degree p2 var = 1 ⟹ p2 = (∑i≤1. isolate_variable_sparse p2 var i * Var var ^ i)" using sum_over_zero by metis have h3g2a : "∀f. (∑i::nat≤1. f i) = f 0 + f 1" by simp have h3g2 : "(∑i::nat≤1. isolate_variable_sparse p2 var i * Var var ^ i) = isolate_variable_sparse p2 var 0 * Var var ^ 0 + isolate_variable_sparse p2 var 1 * Var var ^ 1" using h3g2a by blast have h3g : "MPoly_Type.degree p2 var = 1 ⟹ p2 = A + B * Var var" apply(simp add: sum_over_zero A_def B_def) using h3g1 h3g2 by (metis (no_types, lifting) One_nat_def mult_cancel_left2 power_0 power_one_right) have h3h : "p2 = A + B * Var var" using h3c h3f h3g by auto have h4a : "∃x::real. ∀y::real. insertion (nth_default 0 (list_update L var y)) A = x" using not_contains_insertion not_in_isovarspar A_def by blast have h4b : "∃x::real. ∀y::real. insertion (nth_default 0 (list_update L var y)) B = x" using not_contains_insertion not_in_isovarspar B_def by blast have "aEval (Leq p) (list_update L var ((Av+Bv*sqrt(Cv))/Dv)) = aEval (Leq p1) (list_update L var (sqrt Cv))" using quad_part_1_leq nonzero ha hb hd p1_def lLength by metis also have "... = aEval (Leq p2) (list_update L var (sqrt Cv))" using p2_def quad_part_2_leq hc detGreater0 lLength by metis also have "... = aEval (Leq (A + B * Var var)) (list_update L var (sqrt Cv))" using h3h by auto also have h4 : "... = eval (Or (And (Atom(Leq(A))) (Atom (Leq(B^2*c-A^2)))) (And (Atom(Leq B)) (Atom(Leq (A^2-B^2*c))))) (list_update L var (sqrt Cv))" using quadratic_sub_leq_helper hc detGreater0 h4a h4b lLength by blast also have "... = eval (quadratic_sub var a b c d (Leq p)) (list_update L var (sqrt Cv))" using p1_def quadratic_sub.simps(3) p2_def A_def B_def by metis finally show ?thesis by blast qed (*------------------------------------------------------------------------------------------------*) lemma quadratic_sub_neq : assumes lLength : "length L > var" assumes nonzero : "Dv ≠ 0" assumes detGreater0 : "Cv ≥ 0" assumes freeC : "var ∉ vars c" assumes ha : "∀x. insertion (nth_default 0 (list_update L var x)) (a::real mpoly) = (Av :: real)" assumes hb : "∀x. insertion (nth_default 0 (list_update L var x)) (b::real mpoly) = (Bv :: real)" assumes hc : "∀x. insertion (nth_default 0 (list_update L var x)) (c::real mpoly) = (Cv :: real)" assumes hd : "∀x. insertion (nth_default 0 (list_update L var x)) (d::real mpoly) = (Dv :: real)" shows "aEval (Neq p) (list_update L var ((Av+Bv*sqrt(Cv))/Dv)) = eval (quadratic_sub var a b c d (Neq p)) (list_update L var (sqrt Cv))" proof - define p1 where "(p1::real mpoly) = quadratic_part_1 var a b d (Neq p)" define p2 where "(p2::real mpoly) = quadratic_part_2 var c p1" define A where "A = isolate_variable_sparse p2 var 0" define B where "B = isolate_variable_sparse p2 var 1" have h3b : "MPoly_Type.degree p2 var ≤ 1" using freeC quad_part_2_deg p2_def lLength by metis then have h3c : "MPoly_Type.degree p2 var = 0 ∨ MPoly_Type.degree p2 var = 1" by auto have h3d : "MPoly_Type.degree p2 var = 0 ⟹ B = 0" by(simp add: B_def isovar_greater_degree) then have h3f : "MPoly_Type.degree p2 var = 0 ⟹ p2 = A + B * Var var" by(simp add: h3d A_def degree0isovarspar) have h3g1 : "MPoly_Type.degree p2 var = 1 ⟹ p2 = (∑i≤1. isolate_variable_sparse p2 var i * Var var ^ i)" using sum_over_zero by metis have h3g2a : "∀f. (∑i::nat≤1. f i) = f 0 + f 1" by simp have h3g2 : "(∑i::nat≤1. isolate_variable_sparse p2 var i * Var var ^ i) = isolate_variable_sparse p2 var 0 * Var var ^ 0 + isolate_variable_sparse p2 var 1 * Var var ^ 1" using h3g2a by blast have h3g : "MPoly_Type.degree p2 var = 1 ⟹ p2 = A + B * Var var" apply(simp add: sum_over_zero A_def B_def) using h3g1 h3g2 by (metis (no_types, lifting) One_nat_def mult_cancel_left2 power_0 power_one_right) have h3h : "p2 = A + B * Var var" using h3c h3f h3g by auto have h4a : "∃x::real. ∀y::real. insertion (nth_default 0 (list_update L var y)) A = x" using not_contains_insertion not_in_isovarspar A_def by blast have h4b : "∃x::real. ∀y::real. insertion (nth_default 0 (list_update L var y)) B = x" using not_contains_insertion not_in_isovarspar B_def by blast have h4c : "aEval (Eq (A + B * Var var)) (list_update L var (sqrt Cv)) = eval (And (Atom(Leq (A*B))) (Atom (Eq (A^2-B^2*c)))) (list_update L var (sqrt Cv))" using quad_equality_helper hc detGreater0 h4a h4b lLength by blast have h4d : "aEval (Neq (A + B * Var var)) (list_update L var (sqrt Cv)) = (¬ (eval (And (Atom(Leq (A*B))) (Atom (Eq (A^2-B^2*c)))) (list_update L var (sqrt Cv))))" using aEval.simps(1) aEval.simps(4) h4c by blast have h4e : "(¬ (eval (And (Atom(Leq (A*B))) (Atom (Eq (A^2-B^2*c)))) (list_update L var (sqrt Cv)))) = eval (Or (Atom(Less(-A*B))) (Atom (Neq(A^2-B^2*c)))) (list_update L var (sqrt Cv))" by (metis aNeg.simps(2) aNeg.simps(3) aNeg_aEval eval.simps(1) eval.simps(4) eval.simps(5) mult_minus_left) have "aEval (Neq p) (list_update L var ((Av+Bv*sqrt(Cv))/Dv)) = aEval (Neq p1) (list_update L var (sqrt Cv))" using quad_part_1_neq nonzero ha hb hd p1_def lLength by blast also have "... = aEval (Neq p2) (list_update L var (sqrt Cv))" using p2_def quad_part_2_neq hc detGreater0 lLength by metis also have "... = aEval (Neq (A + B * Var var)) (list_update L var (sqrt Cv))" using h3h by auto also have "... = eval (Or (Atom(Less(-A*B))) (Atom (Neq(A^2-B^2*c)))) (list_update L var (sqrt Cv))" using h4c h4d h4e by auto also have "... = eval (quadratic_sub var a b c d (Neq p)) (list_update L var (sqrt Cv))" using p2_def A_def B_def p1_def quadratic_sub.simps(4) quadratic_part_1.simps(1) quadratic_part_1.simps(4) by (metis (no_types, lifting)) finally show ?thesis by blast qed (*-----------------------------------------------------------------------------------------------*) theorem free_in_quad : assumes freeA : "var∉ vars a" assumes freeB : "var∉ vars b" assumes freeC : "var∉ vars c" assumes freeD : "var∉ vars d" shows "freeIn var (quadratic_sub var a b c d A)" proof(cases A) case (Less p) define p1 where "(p1::real mpoly) = quadratic_part_1 var a b d (Less p)" define p2 where "(p2::real mpoly) = quadratic_part_2 var c p1" define A where "A = isolate_variable_sparse p2 var 0" define B where "B = isolate_variable_sparse p2 var 1" have h1 : "freeIn var (quadratic_sub var a b c d (Less p)) = freeIn var (Or (And (fm.Atom (Less A)) (fm.Atom (Less (B⇧2 * c - A⇧2)))) (And (fm.Atom (Leq B)) (Or (fm.Atom (Less A)) (fm.Atom (Less (A⇧2 - B⇧2 * c))))))" using p2_def A_def B_def p1_def quadratic_sub.simps(2) by metis have h2d : "var∉vars(4::real mpoly)" by (metis freeB not_in_add not_in_pow numeral_Bit0 one_add_one power_0) have h2 : "freeIn var ((Or (And (fm.Atom (Less A)) (fm.Atom (Less (B⇧2 * c - A⇧2)))) (And (fm.Atom (Leq B)) (Or (fm.Atom (Less A)) (fm.Atom (Less (A⇧2 - B⇧2 * c)))))))" using vars_mult not_in_isovarspar A_def B_def not_in_sub not_in_mult not_in_neg not_in_pow not_in_isovarspar h2d freeC by (simp) show ?thesis using h1 h2 Less by blast next case (Eq p) define p1 where "(p1::real mpoly) = quadratic_part_1 var a b d (Eq p)" define p2 where "(p2::real mpoly) = quadratic_part_2 var c p1" define A where "A = isolate_variable_sparse p2 var 0" define B where "B = isolate_variable_sparse p2 var 1" have h1 : "freeIn var (quadratic_sub var a b c d (Eq p)) = freeIn var (And (Atom(Leq (A*B))) (Atom (Eq (A⇧2 - B⇧2 * c))))" using p2_def A_def B_def p1_def quadratic_sub.simps(1) by metis have h2d : "var∉vars(4::real mpoly)" by (metis freeB not_in_add not_in_pow numeral_Bit0 one_add_one power_0) have h2 : "freeIn var (And (Atom(Leq (A*B))) (Atom (Eq (A⇧2 - B⇧2 * c))))" using vars_mult not_in_isovarspar A_def B_def not_in_sub not_in_mult not_in_neg not_in_pow not_in_isovarspar h2d freeC by (simp) show ?thesis using h1 h2 Eq by blast next case (Leq p) define p1 where "(p1::real mpoly) = quadratic_part_1 var a b d (Leq p)" define p2 where "(p2::real mpoly) = quadratic_part_2 var c p1" define A where "A = isolate_variable_sparse p2 var 0" define B where "B = isolate_variable_sparse p2 var 1" have h1 : "freeIn var (quadratic_sub var a b c d (Leq p)) = freeIn var (Or(And(Atom(Leq(A)))(Atom (Leq(B^2*c-A^2))))(And(Atom(Leq B))(Atom(Leq (A^2-B^2*c)))))" using p2_def A_def B_def p1_def quadratic_sub.simps(3) by metis have h2d : "var∉vars(4::real mpoly)" by (metis freeB not_in_add not_in_pow numeral_Bit0 one_add_one power_0) have h2 : "freeIn var (Or(And(Atom(Leq(A)))(Atom (Leq(B^2*c-A^2))))(And(Atom(Leq B))(Atom(Leq (A^2-B^2*c)))))" using vars_mult not_in_isovarspar A_def B_def not_in_sub not_in_mult not_in_neg not_in_pow not_in_isovarspar h2d freeC by (simp) show ?thesis using h1 h2 Leq by blast next case (Neq p) define p1 where "(p1::real mpoly) = quadratic_part_1 var a b d (Neq p)" define p2 where "(p2::real mpoly) = quadratic_part_2 var c p1" define A where "A = isolate_variable_sparse p2 var 0" define B where "B = isolate_variable_sparse p2 var 1" have h1 : "freeIn var (quadratic_sub var a b c d (Neq p)) = freeIn var (Or (Atom(Less(-A*B))) (Atom (Neq(A^2-B^2*c))))" using p2_def A_def B_def p1_def quadratic_sub.simps(4) by metis have h2d : "var∉vars(4::real mpoly)" by (metis freeB not_in_add not_in_pow numeral_Bit0 one_add_one power_0) have h2 : "freeIn var (Or (Atom(Less(-A*B))) (Atom (Neq(A^2-B^2*c))))" using vars_mult not_in_isovarspar A_def B_def not_in_sub not_in_mult not_in_neg not_in_pow not_in_isovarspar h2d freeC by (simp) show ?thesis using h1 h2 Neq by blast qed theorem quadratic_sub : assumes lLength : "length L > var" assumes nonzero : "Dv ≠ 0" assumes detGreater0 : "Cv ≥ 0" assumes freeC : "var ∉ vars c" assumes ha : "∀x. insertion (nth_default 0 (list_update L var x)) (a::real mpoly) = (Av :: real)" assumes hb : "∀x. insertion (nth_default 0 (list_update L var x)) (b::real mpoly) = (Bv :: real)" assumes hc : "∀x. insertion (nth_default 0 (list_update L var x)) (c::real mpoly) = (Cv :: real)" assumes hd : "∀x. insertion (nth_default 0 (list_update L var x)) (d::real mpoly) = (Dv :: real)" shows "aEval A (list_update L var ((Av+Bv*sqrt(Cv))/Dv)) = eval (quadratic_sub var a b c d A) (list_update L var (sqrt Cv))" proof(cases A) case (Less x1) then show ?thesis using quadratic_sub_less assms by blast next case (Eq x2) then show ?thesis using quadratic_sub_eq assms by blast next case (Leq x3) then show ?thesis using quadratic_sub_leq assms by blast next case (Neq x4) then show ?thesis using quadratic_sub_neq assms by blast qed lemma free_in_quad_fm_helper : assumes freeA : "var∉ vars a" assumes freeB : "var∉ vars b" assumes freeC : "var∉ vars c" assumes freeD : "var∉ vars d" shows "freeIn (var+z) (quadratic_sub_fm_helper var a b c d F z)" proof(induction F arbitrary: z) case TrueF then show ?case by auto next case FalseF then show ?case by auto next case (Atom x) then show ?case using free_in_quad[OF not_in_lift[OF assms(1)] not_in_lift[OF assms(2)] not_in_lift[OF assms(3)] not_in_lift[OF assms(4)], of z] by auto next case (And F1 F2) then show ?case by auto next case (Or F1 F2) then show ?case by auto next case (Neg F) then show ?case by auto next case (ExQ F) show ?case using ExQ[of "z+1"] by simp next case (AllQ F) show ?case using AllQ[of "z+1"] by simp next case (ExN x1 F) then show ?case by (metis (no_types, lifting) add.assoc freeIn.simps(13) liftmap.simps(10) quadratic_sub_fm_helper.simps) next case (AllN x1 F) then show ?case by (metis (no_types, lifting) freeIn.simps(12) group_cancel.add1 liftmap.simps(9) quadratic_sub_fm_helper.simps) qed theorem free_in_quad_fm : assumes freeA : "var∉ vars a" assumes freeB : "var∉ vars b" assumes freeC : "var∉ vars c" assumes freeD : "var∉ vars d" shows "freeIn var (quadratic_sub_fm var a b c d A)" using free_in_quad_fm_helper[OF assms, of 0] by auto lemma quadratic_sub_fm_helper : assumes nonzero : "Dv ≠ 0" assumes detGreater0 : "Cv ≥ 0" assumes freeC : "var ∉ vars c" assumes lLength : "length L > var+z" assumes ha : "∀x. insertion (nth_default 0 (list_update (drop z L) var x)) (a::real mpoly) = (Av :: real)" assumes hb : "∀x. insertion (nth_default 0 (list_update (drop z L) var x)) (b::real mpoly) = (Bv :: real)" assumes hc : "∀x. insertion (nth_default 0 (list_update (drop z L) var x)) (c::real mpoly) = (Cv :: real)" assumes hd : "∀x. insertion (nth_default 0 (list_update (drop z L) var x)) (d::real mpoly) = (Dv :: real)" shows "eval F (list_update L (var+z) ((Av+Bv*sqrt(Cv))/Dv)) = eval (quadratic_sub_fm_helper var a b c d F z) (list_update L (var+z) (sqrt Cv))" using assms proof(induction F arbitrary: z L) case TrueF then show ?case by auto next case FalseF then show ?case by auto next case (Atom x) define L1 where "L1 = drop z L" define L2 where "L2 = take z L" have L_def : "L = L2 @ L1" using L1_def L2_def by auto have lengthl2 : "length L2 = z" using L2_def using Atom.prems(4) by auto have "eval (Atom(Eq (a-Const Av))) ([] @ L1) = eval (liftFm 0 z (Atom(Eq (a- Const Av)))) ([] @ L2 @ L1)" by (metis eval_liftFm_helper lengthl2 list.size(3)) then have "(insertion (nth_default 0 (L2 @ L1)) (liftPoly 0 z (a - Const Av)) = 0)" apply(simp add: insertion_sub insertion_const) using Atom(5) unfolding L1_def by (metis list_update_id) then have "insertion (nth_default 0 (L2 @ L1)) (liftPoly 0 z a) = Av" using lift_minus by blast then have a1 : "∀x. insertion (nth_default 0 (L[var + z := x])) (liftPoly 0 z a) = Av" unfolding L_def by (metis (no_types, lifting) Atom.prems(5) L1_def add.right_neutral add_diff_cancel_right' append_eq_append_conv append_eq_append_conv2 length_append lengthl2 lift_insertion list.size(3) list_update_append not_add_less2) have "eval (Atom(Eq (b-Const Bv))) ([] @ L1) = eval (liftFm 0 z (Atom(Eq (b- Const Bv)))) ([] @ L2 @ L1)" by (metis eval_liftFm_helper lengthl2 list.size(3)) then have "(insertion (nth_default 0 (L2 @ L1)) (liftPoly 0 z (b - Const Bv)) = 0)" apply(simp add: insertion_sub insertion_const) using Atom(6) unfolding L1_def by (metis list_update_id) then have "insertion (nth_default 0 (L2 @ L1)) (liftPoly 0 z b) = Bv" using lift_minus by blast then have a2 : "∀x. insertion (nth_default 0 (L[var + z := x])) (liftPoly 0 z b) = Bv" unfolding L_def using Atom(6) L1_def by (metis L_def add_diff_cancel_right' append.simps(1) lengthl2 lift_insertion list.size(3) list_update_append not_add_less2) have "eval (Atom(Eq (c-Const Cv))) ([] @ L1) = eval (liftFm 0 z (Atom(Eq (c- Const Cv)))) ([] @ L2 @ L1)" by (metis eval_liftFm_helper lengthl2 list.size(3)) then have "(insertion (nth_default 0 (L2 @ L1)) (liftPoly 0 z (c - Const Cv)) = 0)" apply(simp add: insertion_sub insertion_const) using Atom(7) unfolding L1_def by (metis list_update_id) then have "insertion (nth_default 0 (L2 @ L1)) (liftPoly 0 z c) = Cv" using lift_minus by blast then have a3 : "∀x. insertion (nth_default 0 (L[var + z := x])) (liftPoly 0 z c) = Cv" unfolding L_def proof - obtain nn :: "(nat ⇒ real) ⇒ (nat ⇒ real) ⇒ real mpoly ⇒ nat" where "∀x0 x1 x2. (∃v3. v3 ∈ vars x2 ∧ x1 v3 ≠ x0 v3) = (nn x0 x1 x2 ∈ vars x2 ∧ x1 (nn x0 x1 x2) ≠ x0 (nn x0 x1 x2))" by moura then have f1: "∀m f fa. nn fa f m ∈ vars m ∧ f (nn fa f m) ≠ fa (nn fa f m) ∨ insertion f m = insertion fa m" by (meson insertion_irrelevant_vars) obtain rr :: real where "(∃v0. insertion (nth_default 0 ((L2 @ L1)[var + z := v0])) (liftPoly 0 z c) ≠ Cv) = (insertion (nth_default 0 ((L2 @ L1)[var + z := rr])) (liftPoly 0 z c) ≠ Cv)" by blast moreover { assume "var + z ≠ nn (nth_default 0 ((L2 @ L1)[var + z := rr])) (nth_default 0 (L2 @ L1)) (liftPoly 0 z c)" moreover { assume "(nth_default 0 (L2 @ L1) (nn (nth_default 0 ((L2 @ L1)[var + z := rr])) (nth_default 0 (L2 @ L1)) (liftPoly 0 z c)) = nth_default 0 ((L2 @ L1)[var + z := rr]) (nn (nth_default 0 ((L2 @ L1)[var + z := rr])) (nth_default 0 (L2 @ L1)) (liftPoly 0 z c))) ≠ ((L2 @ L1) ! nn (nth_default 0 ((L2 @ L1)[var + z := rr])) (nth_default 0 (L2 @ L1)) (liftPoly 0 z c) = (L2 @ L1)[var + z := rr] ! nn (nth_default 0 ((L2 @ L1)[var + z := rr])) (nth_default 0 (L2 @ L1)) (liftPoly 0 z c))" then have "nth_default 0 ((L2 @ L1)[var + z := rr]) (nn (nth_default 0 ((L2 @ L1)[var + z := rr])) (nth_default 0 (L2 @ L1)) (liftPoly 0 z c)) ≠ (L2 @ L1)[var + z := rr] ! nn (nth_default 0 ((L2 @ L1)[var + z := rr])) (nth_default 0 (L2 @ L1)) (liftPoly 0 z c) ∨ nth_default 0 (L2 @ L1) (nn (nth_default 0 ((L2 @ L1)[var + z := rr])) (nth_default 0 (L2 @ L1)) (liftPoly 0 z c)) ≠ (L2 @ L1) ! nn (nth_default 0 ((L2 @ L1)[var + z := rr])) (nth_default 0 (L2 @ L1)) (liftPoly 0 z c)" by linarith then have "nn (nth_default 0 ((L2 @ L1)[var + z := rr])) (nth_default 0 (L2 @ L1)) (liftPoly 0 z c) ∉ vars (liftPoly 0 z c) ∨ nth_default 0 (L2 @ L1) (nn (nth_default 0 ((L2 @ L1)[var + z := rr])) (nth_default 0 (L2 @ L1)) (liftPoly 0 z c)) = nth_default 0 ((L2 @ L1)[var + z := rr]) (nn (nth_default 0 ((L2 @ L1)[var + z := rr])) (nth_default 0 (L2 @ L1)) (liftPoly 0 z c))" by (metis (no_types) append_Nil2 length_list_update nth_default_append) } ultimately have "nn (nth_default 0 ((L2 @ L1)[var + z := rr])) (nth_default 0 (L2 @ L1)) (liftPoly 0 z c) ∉ vars (liftPoly 0 z c) ∨ nth_default 0 (L2 @ L1) (nn (nth_default 0 ((L2 @ L1)[var + z := rr])) (nth_default 0 (L2 @ L1)) (liftPoly 0 z c)) = nth_default 0 ((L2 @ L1)[var + z := rr]) (nn (nth_default 0 ((L2 @ L1)[var + z := rr])) (nth_default 0 (L2 @ L1)) (liftPoly 0 z c))" by force } ultimately show "∀r. insertion (nth_default 0 ((L2 @ L1)[var + z := r])) (liftPoly 0 z c) = Cv" using f1 by (metis (full_types) Atom.prems(3) ‹insertion (nth_default 0 (L2 @ L1)) (liftPoly 0 z c) = Cv› not_in_lift) qed have "eval (Atom(Eq (d-Const Dv))) ([] @ L1) = eval (liftFm 0 z (Atom(Eq (d- Const Dv)))) ([] @ L2 @ L1)" by (metis eval_liftFm_helper lengthl2 list.size(3)) then have "(insertion (nth_default 0 (L2 @ L1)) (liftPoly 0 z (d - Const Dv)) = 0)" apply(simp add: insertion_sub insertion_const) using Atom(8) unfolding L1_def by (metis list_update_id) then have "insertion (nth_default 0 (L2 @ L1)) (liftPoly 0 z d) = Dv" using lift_minus by blast then have a4 : "∀x. insertion (nth_default 0 (L[var + z := x])) (liftPoly 0 z d) = Dv" unfolding L_def by (metis Atom(8) L1_def L_def add_diff_cancel_right' append.simps(1) lengthl2 lift_insertion list.size(3) list_update_append not_add_less2) then show ?case apply(simp) using quadratic_sub[OF Atom(4) Atom(1) Atom(2) not_in_lift[OF Atom(3)], of "(liftPoly 0 z a)" Av "(liftPoly 0 z b)" Bv "(liftPoly 0 z d)" x , OF a1 a2 a3 a4] . next case (And F1 F2) then show ?case by auto next case (Or F1 F2) then show ?case by auto next case (Neg F) then show ?case by auto next case (ExQ F) have lengthG : "var + (z + 1) < length (x#L)" for x using ExQ(5) by auto have forall : "∀x. insertion (nth_default 0 ((drop z L)[var := x])) a = Av ⟹ ∀x. insertion (nth_default 0 ((drop (z + 1) (x1 # L))[var := x])) a = Av" for x1 a Av by auto have l : "x # L[var + z := v] = ((x#L)[var+(z+1):=v])" for x v by auto have "eval (ExQ F) (L[var + z := (Av + Bv * sqrt Cv) / Dv]) = (∃x. eval F (x # L[var + z := (Av + Bv * sqrt Cv) / Dv]))" by(simp) also have "... = (∃x. eval (liftmap (λx. quadratic_sub (var + x) (liftPoly 0 x a) (liftPoly 0 x b) (liftPoly 0 x c) (liftPoly 0 x d)) F (z + 1)) (x # L[var + z := sqrt Cv]))" apply(rule ex_cong1) unfolding l using ExQ(1)[OF ExQ(2) ExQ(3) ExQ(4) lengthG forall[OF ExQ(6)] forall[OF ExQ(7)] forall[OF ExQ(8)] forall[OF ExQ(9)]] unfolding quadratic_sub_fm_helper.simps liftmap.simps by simp also have "... = eval (quadratic_sub_fm_helper var a b c d (ExQ F) z) (L[var + z := sqrt Cv])" unfolding quadratic_sub_fm_helper.simps liftmap.simps eval.simps by auto finally show ?case by simp next case (AllQ F) have lengthG : "var + (z + 1) < length (x#L)" for x using AllQ(5) by auto have forall : "∀x. insertion (nth_default 0 ((drop z L)[var := x])) a = Av ⟹ ∀x. insertion (nth_default 0 ((drop (z + 1) (x1 # L))[var := x])) a = Av" for x1 a Av by auto have l : "x # L[var + z := v] = ((x#L)[var+(z+1):=v])" for x v by auto have "eval (AllQ F) (L[var + z := (Av + Bv * sqrt Cv) / Dv]) = (∀x. eval F (x # L[var + z := (Av + Bv * sqrt Cv) / Dv]))" by(simp) also have "... = (∀x. eval (liftmap (λx. quadratic_sub (var + x) (liftPoly 0 x a) (liftPoly 0 x b) (liftPoly 0 x c) (liftPoly 0 x d)) F (z + 1)) (x # L[var + z := sqrt Cv]))" apply(rule all_cong1) unfolding l using AllQ(1)[OF AllQ(2) AllQ(3) AllQ(4) lengthG forall[OF AllQ(6)] forall[OF AllQ(7)] forall[OF AllQ(8)] forall[OF AllQ(9)]] unfolding quadratic_sub_fm_helper.simps liftmap.simps by simp also have "... = eval (quadratic_sub_fm_helper var a b c d (AllQ F) z) (L[var + z := sqrt Cv])" unfolding quadratic_sub_fm_helper.simps liftmap.simps eval.simps by auto finally show ?case by simp next case (ExN x1 F) have list : "⋀l. length l=x1 ⟹ ((drop (z + x1) l @ drop (z + x1 - length l) L)) = ((drop z L))" by auto have map : "⋀ z L. eval (liftmap (λx A. (quadratic_sub (var + x) (liftPoly 0 x a) (liftPoly 0 x b) (liftPoly 0 x c) (liftPoly 0 x d) A)) F (z + x1)) L = eval (liftmap (λx A. (quadratic_sub (var + x1 + x) (liftPoly 0 (x+x1) a) (liftPoly 0 (x+x1) b) (liftPoly 0 (x+x1) c) (liftPoly 0 (x+x1) d) A)) F z) L" apply(induction F) apply(simp_all add:add.commute add.left_commute) apply force apply force by (metis (mono_tags, lifting) ab_semigroup_add_class.add_ac(1))+ show ?case apply simp apply(rule ex_cong1) subgoal for l using map[of z] list[of l] ExN(1)[OF ExN(2-4), of "z+x1" "l@L"] ExN(5-9) list_update_append apply auto by (simp add: list_update_append) + done next case (AllN x1 F) have list : "⋀l. length l=x1 ⟹ ((drop (z + x1) l @ drop (z + x1 - length l) L)) = ((drop z L))" by auto have map : "⋀ z L. eval (liftmap (λx A. (quadratic_sub (var + x) (liftPoly 0 x a) (liftPoly 0 x b) (liftPoly 0 x c) (liftPoly 0 x d) A)) F (z + x1)) L = eval (liftmap (λx A. (quadratic_sub (var + x1 + x) (liftPoly 0 (x+x1) a) (liftPoly 0 (x+x1) b) (liftPoly 0 (x+x1) c) (liftPoly 0 (x+x1) d) A)) F z) L" apply(induction F) apply(simp_all add:add.commute add.left_commute) apply force apply force by (metis (mono_tags, lifting) ab_semigroup_add_class.add_ac(1))+ show ?case apply simp apply(rule all_cong1) subgoal for l using map[of z] list[of l] AllN(1)[OF AllN(2-4), of "z+x1" "l@L"] AllN(5-9) apply auto by (simp add: list_update_append) + done qed theorem quadratic_sub_fm : assumes lLength : "length L > var" assumes nonzero : "Dv ≠ 0" assumes detGreater0 : "Cv ≥ 0" assumes freeC : "var ∉ vars c" assumes ha : "∀x. insertion (nth_default 0 (list_update L var x)) (a::real mpoly) = (Av :: real)" assumes hb : "∀x. insertion (nth_default 0 (list_update L var x)) (b::real mpoly) = (Bv :: real)" assumes hc : "∀x. insertion (nth_default 0 (list_update L var x)) (c::real mpoly) = (Cv :: real)" assumes hd : "∀x. insertion (nth_default 0 (list_update L var x)) (d::real mpoly) = (Dv :: real)" shows "eval F (list_update L var ((Av+Bv*sqrt(Cv))/Dv)) = eval (quadratic_sub_fm var a b c d F) (list_update L var (sqrt Cv))" unfolding quadratic_sub_fm.simps using quadratic_sub_fm_helper[OF assms(2) assms(3) assms(4), of 0 L a Av b Bv d F] assms(1) assms(5) assms(6) assms(7) assms(8) by (simp add: lLength) end
subsection "Lemmas of the elimVar function" theory EliminateVariable imports LinearCase QuadraticCase "HOL-Library.Quadratic_Discriminant" begin lemma elimVar_eq : assumes hlength : "length xs = var" assumes in_list : "Eq p ∈ set(L)" assumes low_pow : "MPoly_Type.degree p var = 1 ∨ MPoly_Type.degree p var = 2" shows "((∃x. eval (list_conj (map fm.Atom L @ F)) (xs @ x # Γ)) = ((∃x. eval (elimVar var L F (Eq p)) (xs @ x # Γ)))∨ (∀x. aEval (Eq p) (xs @ x # Γ)))" proof- { fix x define A where "A = (isolate_variable_sparse p var 2)" define B where "B = (isolate_variable_sparse p var 1)" define C where "C = (isolate_variable_sparse p var 0)" have freeA : "var ∉ vars A" unfolding A_def by (simp add: not_in_isovarspar) have freeB : "var ∉ vars B" unfolding B_def by (simp add: not_in_isovarspar) have freeC : "var ∉ vars C" unfolding C_def by (simp add: not_in_isovarspar) assume "eval (list_conj (map fm.Atom L @ F)) (xs @ x # Γ)" then have h : "(∀a∈set L. aEval a (xs @ x # Γ)) ∧ (∀f∈set F. eval f (xs @ x # Γ))" apply(simp add:eval_list_conj) by (meson Un_iff eval.simps(1) image_eqI) define X where "X=xs@x#Γ" have Xlength : "length X > var" using X_def hlength by auto define Aval where "Aval = insertion (nth_default 0 (list_update X var x)) A" define Bval where "Bval = insertion (nth_default 0 (list_update X var x)) B" define Cval where "Cval = insertion (nth_default 0 (list_update X var x)) C" have hinsert : "(xs @ x # Γ)[var := x] = (xs @ x #Γ)" using hlength by auto have allAval : "∀x. insertion (nth_default 0 (xs @ x # Γ)) A = Aval" using Aval_def using not_contains_insertion[where var="var", where p = "A", OF freeA, where L = "xs @ x #Γ", where x="x", where val="Aval"] unfolding X_def hinsert using hlength by auto have allBval : "∀x. insertion (nth_default 0 (xs @ x # Γ)) B = Bval" using Bval_def using not_contains_insertion[where var="var", where p = "B", OF freeB, where L = "xs @ x #Γ", where x="x", where val="Bval"] unfolding X_def hinsert using hlength by auto have allCval : "∀x. insertion (nth_default 0 (xs @ x # Γ)) C = Cval" using Cval_def using not_contains_insertion[where var="var", where p = "C", OF freeC, where L = "xs @ x #Γ", where x="x", where val="Cval"] unfolding X_def hinsert using hlength by auto have insertion_p : "insertion (nth_default 0 X) p = 0" using in_list h aEval.simps(1) X_def by fastforce have express_p : "p = A * Var var ^ 2 + B * Var var + C" using express_poly[OF low_pow] unfolding A_def B_def C_def by fastforce have insertion_p' : "Aval *x^2+Bval *x+Cval = 0" using express_p insertion_p unfolding Aval_def Bval_def Cval_def X_def hinsert apply(simp add: insertion_add insertion_mult insertion_pow) using insertion_var by (metis X_def Xlength hinsert) have biglemma : " ((Aval = 0 ∧ Bval ≠ 0 ∧ (∀f∈set L. aEval (linear_substitution var (-C) B f) (xs @ x # Γ)) ∧ (∀f∈set F. eval (linear_substitution_fm var (-C) B f) (xs @ x # Γ)) ∨ Aval ≠ 0 ∧ insertion (nth_default 0 (xs @ x # Γ)) 4 * Aval * Cval ≤ (Bval)⇧2 ∧ ((∀f∈set L. eval (quadratic_sub var (- B) 1 (B⇧2 - 4 * A * C) (2 * A) f) (xs @ x # Γ))∧ (∀f∈set F. eval (quadratic_sub_fm var (- B) 1 (B⇧2 - 4 * A * C) (2 * A) f) (xs @ x # Γ)) ∨ (∀f∈set L. eval (quadratic_sub var (- B) (-1) (B⇧2 - 4 * A * C) (2 * A) f) (xs @ x # Γ)) ∧ (∀f∈set F. eval (quadratic_sub_fm var (- B) (-1) (B⇧2 - 4 * A * C) (2 * A) f) (xs @ x # Γ))) ∨ Aval = 0 ∧ Bval = 0 ∧ Cval = 0))" proof(cases "Aval=0") case True then have aval0 : "Aval=0" by simp show ?thesis proof(cases "Bval=0") case True then have bval0 : "Bval=0" by simp have h : "eval (list_conj (map fm.Atom L @ F)) (xs @ x # Γ)" using hlength h unfolding X_def using ‹eval (list_conj (map fm.Atom L @ F)) (xs @ x # Γ)› by blast show ?thesis proof(cases "Cval=0") case True show ?thesis by(simp add:aval0 True bval0) next case False show ?thesis using insertion_p' aval0 bval0 False by(simp) qed next case False have bh : "insertion (nth_default 0 (X[var := - Cval / Bval])) B = Bval" using allBval unfolding X_def using Bval_def X_def freeB not_contains_insertion by blast have ch : "insertion (nth_default 0 (X[var := - Cval / Bval])) C = Cval" using allCval unfolding X_def using Cval_def X_def freeC not_contains_insertion by blast have xh : "x=-Cval/Bval" proof- have "Bval*x+Cval = 0" using insertion_p' aval0 by simp then show ?thesis using False by (smt nonzero_mult_div_cancel_left) qed have freecneg : "var ∉ vars (-C)" using freeC not_in_neg by auto have h1: "(∀a∈set L. aEval (linear_substitution var (-C) (B) a) (X[var := x]))" using h xh Bval_def Cval_def False LinearCase.linear[OF Xlength False freecneg freeB, of "-Cval"] freeB freeC freecneg by (metis X_def hinsert insertion_neg) have h2 : "∀f∈set F. eval (linear_substitution_fm var (-C) B f) (X[var := x])" using h xh Bval_def Cval_def False LinearCase.linear_fm[OF Xlength False freecneg freeB, of "-Cval"] freeB freeC by (metis X_def hinsert insertion_neg) show ?thesis using h1 h2 apply(simp add:aval0 False) using X_def hlength using hinsert by auto qed next case False then have aval0 : "Aval ≠0" by simp have h4 : "insertion (nth_default 0 (X[var := x])) 4 = 4" using insertion_const[where f = "(nth_default 0 (X[var := x]))", where c="4"] by (metis MPoly_Type.insertion_one insertion_add numeral_Bit0 one_add_one) show ?thesis proof(cases "4 * Aval * Cval ≤ Bval⇧2") case True have h1a : "var∉vars(-B)" by(simp add: freeB not_in_neg) have h1b : "var∉vars(1::real mpoly)" using isolate_var_one not_in_isovarspar by blast have h1c : "var∉vars(-1::real mpoly)" by(simp add: h1b not_in_neg) have h1d : "var∉vars(4::real mpoly)" by (metis h1b not_in_add numeral_Bit0 one_add_one) have h1e : "var∉vars(B^2-4*A*C)" by(simp add: freeB h1d freeA freeC not_in_mult not_in_pow not_in_sub) have h1f : "var∉vars(2::real mpoly)" using h1b not_in_add by fastforce have h1g : "var∉vars(2*A)" by(simp add: freeA h1f not_in_mult) have h1h : "freeIn var (quadratic_sub var (-B) (1) (B^2-4*A*C) (2*A) a)" using free_in_quad h1a h1b h1e h1g by blast have h1i : "freeIn var (quadratic_sub var (-B) (-1) (B^2-4*A*C) (2*A) a)" using free_in_quad h1a h1c h1e h1g by blast have h2 : "2*Aval ≠ 0" using aval0 by auto have h3 : "0 ≤ (Bval^2-4*Aval*Cval)" using True by auto have h4a : "var ∉ vars 4" by (metis monom_numeral notInKeys_notInVars not_in_add not_in_isovarspar not_in_pow one_add_one power.simps(1) rel_simps(76) vars_monom_keys) have h4 : "var ∉ vars (B^2-4*A*C)" by(simp add: h4a freeA freeB freeC not_in_pow not_in_mult not_in_sub) have h5 : "∀x. insertion (nth_default 0 (list_update X var x)) (-B) = -Bval " using allBval apply(simp add: insertion_neg) by (simp add: B_def Bval_def insertion_isovarspars_free) have h6 : "∀x. insertion (nth_default 0 (list_update X var x)) 1 = 1" by simp have h6a : "∀x. insertion (nth_default 0 (list_update X var x)) (-1) = (-1)" using h6 by (simp add: insertion_neg) have h7a : "∀x. insertion (nth_default 0 (list_update X var x)) 4 = 4" by (metis h6 insertion_add numeral_Bit0 one_add_one) have h7b : "var ∉ vars(4*A*C)" using freeA freeC by (simp add: h4a not_in_mult) have h7c : "var ∉ vars(B^2)" using freeB not_in_pow by auto have h7 : "∀x. insertion (nth_default 0 (list_update X var x)) (B^2-4*A*C) = (Bval^2-4*Aval*Cval)" using h7a allAval allBval allCval unfolding X_def using hlength apply (simp add: insertion_mult insertion_sub power2_eq_square) by (metis A_def Aval_def Bval_def C_def Cval_def X_def freeB insertion_isovarspars_free not_contains_insertion) have h8a : "∀x. insertion (nth_default 0 (list_update X var x)) 2 = 2" by (metis h6 insertion_add one_add_one) have h8 : "∀x. insertion (nth_default 0 (list_update X var x)) (2*A) = (2*Aval)" apply(simp add: allAval h8a insertion_mult) by (simp add: A_def Aval_def insertion_isovarspars_free) have h1 : "- Bval⇧2 + 4 * Aval * Cval ≤ 0" using True by simp have xh : "x = (- Bval + sqrt (Bval⇧2 - 4 * Aval * Cval)) / (2 * Aval)∨x=(- Bval - sqrt (Bval⇧2 - 4 * Aval * Cval)) / (2 * Aval)" using insertion_p' aval0 h1 discriminant_iff unfolding discrim_def by blast have p1 : "x = (- Bval + sqrt (Bval⇧2 - 4 * Aval * Cval)) / (2 * Aval) ⟹ ((∀a∈ set L. eval (quadratic_sub var (-B) 1 (B^2-4*A*C) (2*A) a) (X[var := x])) ∧(∀a∈ set F. eval (quadratic_sub_fm var (-B) 1 (B^2-4*A*C) (2*A) a) (X[var := x])))" proof- assume x_def : "x = (- Bval + sqrt (Bval⇧2 - 4 * Aval * Cval)) / (2 * Aval)" then have h : "(∀a∈set L. aEval a (X[var := (- Bval + sqrt (Bval⇧2 - 4 * Aval * Cval)) / (2 * Aval)])) ∧ (∀f∈set F. eval f (X[var := (- Bval + sqrt (Bval⇧2 - 4 * Aval * Cval)) / (2 * Aval)]))" using h using X_def hinsert by auto { fix a assume in_list : "a∈ set L" have "eval (quadratic_sub var (- B) 1 (B⇧2 - 4 * A * C) (2 * A) a) (X[var := x])" using free_in_quad[where a="-B",where b="1", where c="(B^2-4*A*C)", where d="2*A",where var="var",OF h1a h1b h1e h1g] using quadratic_sub[where a="-B",where b="1", where c="(B^2-4*A*C)", where d="2*A",where var="var", where L="X", OF Xlength, where Dv="2*Aval", OF h2, where Cv="(Bval^2-4*Aval*Cval)", OF h3, where Av="-Bval", OF h4 h5, where Bv="1", OF h6 h7 h8] h in_list using var_not_in_eval by fastforce } then have left : "(∀a∈set L. eval (quadratic_sub var (- B) 1 (B⇧2 - 4 * A * C) (2 * A) a) (X[var := x]))" by simp { fix a assume in_list : "a∈ set F" have "eval (quadratic_sub_fm var (- B) 1 (B⇧2 - 4 * A * C) (2 * A) a) (X[var := x])" using free_in_quad_fm[where a="-B",where b="1", where c="(B^2-4*A*C)", where d="2*A",where var="var",OF h1a h1b h1e h1g] using quadratic_sub_fm[where a="-B",where b="1", where c="(B^2-4*A*C)", where d="2*A",where var="var", where L="X", OF Xlength, where Dv="2*Aval", OF h2, where Cv="(Bval^2-4*Aval*Cval)", OF h3, where Av="-Bval", OF h4 h5, where Bv="1", OF h6 h7 h8] h in_list using var_not_in_eval by fastforce } then have right : "(∀a∈set F. eval (quadratic_sub_fm var (- B) 1 (B⇧2 - 4 * A * C) (2 * A) a) (X[var := x]))" by simp show ?thesis using right left by simp qed have p2 : "x = (- Bval - sqrt (Bval⇧2 - 4 * Aval * Cval)) / (2 * Aval) ⟹ ((∀a∈ set L. eval (quadratic_sub var (-B) (-1) (B^2-4*A*C) (2*A) a) (X[var := x])) ∧(∀a∈ set F. eval (quadratic_sub_fm var (-B) (-1) (B^2-4*A*C) (2*A) a) (X[var := x])))" proof - assume x_def : "x = (- Bval - sqrt (Bval⇧2 - 4 * Aval * Cval)) / (2 * Aval)" then have h : "(∀a∈set L. aEval a (X[var := (- Bval - sqrt (Bval⇧2 - 4 * Aval * Cval)) / (2 * Aval)])) ∧ (∀f∈set F. eval f (X[var := (- Bval - sqrt (Bval⇧2 - 4 * Aval * Cval)) / (2 * Aval)]))" using h using X_def hinsert by auto then have "(∀a∈set L. aEval a (X[var := (- Bval - sqrt (Bval⇧2 - 4 * Aval * Cval)) / (2 * Aval)])) ∧ (∀f∈set F. eval f (X[var := (- Bval - sqrt (Bval⇧2 - 4 * Aval * Cval)) / (2 * Aval)]))" using h by simp { fix a assume in_list : "a∈ set L" have "eval (quadratic_sub var (- B) (-1) (B⇧2 - 4 * A * C) (2 * A) a) (X[var := x])" using free_in_quad[where a="-B",where b="-1", where c="(B^2-4*A*C)", where d="2*A",where var="var",OF h1a h1c h1e h1g] using quadratic_sub[where a="-B",where b="-1", where c="(B^2-4*A*C)", where d="2*A",where var="var", where L="X", OF Xlength, where Dv="2*Aval", OF h2, where Cv="(Bval^2-4*Aval*Cval)", OF h3, where Av="-Bval", OF h4 h5, where Bv="-1", OF h6a h7 h8] h in_list using var_not_in_eval by fastforce } then have left : "(∀a∈set L. eval (quadratic_sub var (- B) (-1) (B⇧2 - 4 * A * C) (2 * A) a) (X[var := x]))" by simp { fix a assume in_list : "a∈ set F" have "eval (quadratic_sub_fm var (- B) (-1) (B⇧2 - 4 * A * C) (2 * A) a) (X[var := x])" using free_in_quad_fm[where a="-B",where b="-1", where c="(B^2-4*A*C)", where d="2*A",where var="var",OF h1a h1c h1e h1g] using quadratic_sub_fm[where a="-B",where b="-1", where c="(B^2-4*A*C)", where d="2*A",where var="var", where L="X", OF Xlength, where Dv="2*Aval", OF h2, where Cv="(Bval^2-4*Aval*Cval)", OF h3, where Av="-Bval", OF h4 h5, where Bv="-1", OF h6a h7 h8] h in_list using var_not_in_eval by fastforce } then have right : "(∀a∈set F. eval (quadratic_sub_fm var (- B) (-1) (B⇧2 - 4 * A * C) (2 * A) a) (X[var := x]))" by simp show ?thesis using right left by simp qed have subst4 : "insertion (nth_default 0 (xs @ x # Γ)) 4 = 4" using h7a hlength X_def by auto have disj: "(∀a∈set L. eval (quadratic_sub var (- B) 1 (B⇧2 - 4 * A * C) (2 * A) a) (xs @ x # Γ)) ∧ (∀a∈set F. eval (quadratic_sub_fm var (- B) 1 (B⇧2 - 4 * A * C) (2 * A) a) (xs @ x # Γ)) ∨ (∀a∈set L. eval (quadratic_sub var (- B) (-1) (B⇧2 - 4 * A * C) (2 * A) a) (xs @ x # Γ)) ∧ (∀a∈set F. eval (quadratic_sub_fm var (- B) (-1) (B⇧2 - 4 * A * C) (2 * A) a) (xs @ x # Γ))" using xh p1 p2 unfolding X_def hinsert by blast show ?thesis apply(simp add: aval0 True h7a subst4) using disj unfolding X_def hinsert by auto next case False then have det : "0 < - Bval⇧2 + 4 * Aval * Cval" by simp show ?thesis apply(simp add: aval0 False h4) using discriminant_negative unfolding discrim_def using insertion_p' using aval0 det by auto qed qed have "(∃x. (insertion (nth_default 0 (xs @ x # Γ)) A = 0 ∧ insertion (nth_default 0 (xs @ x # Γ)) B ≠ 0 ∧ (∀f∈set L. aEval (linear_substitution var (-C) (B) f) (xs @ x # Γ)) ∧ (∀f∈set F. eval (linear_substitution_fm var (-C) B f) (xs @ x # Γ)) ∨ insertion (nth_default 0 (xs @ x # Γ)) A ≠ 0 ∧ insertion (nth_default 0 (xs @ x # Γ)) 4 * insertion (nth_default 0 (xs @ x # Γ)) A * insertion (nth_default 0 (xs @ x # Γ)) C ≤ (insertion (nth_default 0 (xs @ x # Γ)) B)⇧2 ∧ ((∀f∈set L. eval (quadratic_sub var (- B) 1 (B⇧2 - 4 * A * C) (2 * A) f) (xs @ x # Γ))∧ (∀f∈set F. eval (quadratic_sub_fm var (- B) 1 (B⇧2 - 4 * A * C) (2 * A) f) (xs @ x # Γ)) ∨ (∀f∈set L. eval (quadratic_sub var (- B) (-1) (B⇧2 - 4 * A * C) (2 * A) f) (xs @ x # Γ)) ∧ (∀f∈set F. eval (quadratic_sub_fm var (- B) (-1) (B⇧2 - 4 * A * C) (2 * A) f) (xs @ x # Γ)))) ∨ (Aval = 0 ∧ Bval = 0 ∧ Cval = 0))" apply(rule exI[where x=x]) using biglemma using allAval allBval allCval unfolding A_def B_def C_def Aval_def Bval_def Cval_def X_def hinsert by auto then obtain x where x : "(insertion (nth_default 0 (xs @ x # Γ)) A = 0 ∧ insertion (nth_default 0 (xs @ x # Γ)) B ≠ 0 ∧ (∀f∈set L. aEval (linear_substitution var (-C) (B) f) (xs @ x # Γ)) ∧ (∀f∈set F. eval (linear_substitution_fm var (-C) B f) (xs @ x # Γ)) ∨ insertion (nth_default 0 (xs @ x # Γ)) A ≠ 0 ∧ insertion (nth_default 0 (xs @ x # Γ)) 4 * insertion (nth_default 0 (xs @ x # Γ)) A * insertion (nth_default 0 (xs @ x # Γ)) C ≤ (insertion (nth_default 0 (xs @ x # Γ)) B)⇧2 ∧ ((∀f∈set L. eval (quadratic_sub var (- B) 1 (B⇧2 - 4 * A * C) (2 * A) f) (xs @ x # Γ))∧ (∀f∈set F. eval (quadratic_sub_fm var (- B) 1 (B⇧2 - 4 * A * C) (2 * A) f) (xs @ x # Γ)) ∨ (∀f∈set L. eval (quadratic_sub var (- B) (-1) (B⇧2 - 4 * A * C) (2 * A) f) (xs @ x # Γ)) ∧ (∀f∈set F. eval (quadratic_sub_fm var (- B) (-1) (B⇧2 - 4 * A * C) (2 * A) f) (xs @ x # Γ)))) ∨ (Aval = 0 ∧ Bval = 0 ∧ Cval = 0)" by auto have h : "(∃x. eval (elimVar var L F (Eq p)) (xs @ x # Γ))∨(Aval = 0 ∧ Bval = 0 ∧ Cval = 0)" proof(cases "(Aval = 0 ∧ Bval = 0 ∧ Cval = 0)") case True then show ?thesis by simp next case False have "(∃x. eval (elimVar var L F (Eq p)) (xs @ x # Γ))" apply(rule exI[where x=x]) apply(simp add: eval_list_conj insertion_mult insertion_sub insertion_pow insertion_add del: quadratic_sub.simps linear_substitution.simps quadratic_sub_fm.simps linear_substitution_fm.simps) unfolding A_def[symmetric] B_def[symmetric] C_def[symmetric] One_nat_def[symmetric] X_def[symmetric] using hlength x by (auto simp add:False) then show ?thesis by auto qed have "(∃x. eval (elimVar var L F (Eq p)) (xs @ x # Γ))∨(∀x. aEval (Eq p) (xs@ x# Γ))" proof(cases "(∃x. eval (elimVar var L F (Eq p)) (xs @ x # Γ))") case True then show ?thesis by auto next case False then have "(Aval = 0 ∧ Bval = 0 ∧ Cval = 0)" using h by auto then have "(∀x. aEval (Eq p) (xs @ x # Γ))" unfolding express_p apply(simp add:insertion_add insertion_mult insertion_pow) using allAval allBval allCval by auto then show ?thesis by auto qed } then have left : "(∃x. eval (list_conj (map fm.Atom L @ F)) (xs @ x # Γ)) ⟹ ((∃x. eval (elimVar var L F (Eq p)) (xs @ x # Γ))∨(∀x. aEval (Eq p) (xs@ x# Γ)))" by blast { assume hlength : "length (xs::real list) = var" define A where "A = (isolate_variable_sparse p var 2)" define B where "B = (isolate_variable_sparse p var 1)" define C where "C = (isolate_variable_sparse p var 0)" have freeA : "var ∉ vars A" unfolding A_def by (simp add: not_in_isovarspar) have freeB : "var ∉ vars B" unfolding B_def by (simp add: not_in_isovarspar) have freeC : "var ∉ vars C" unfolding C_def by (simp add: not_in_isovarspar) have express_p : "p = A*(Var var)^2+B*(Var var)+C" using express_poly[OF low_pow] unfolding A_def B_def C_def by fastforce assume h : "(∃x. (eval (elimVar var L F (Eq p)) (list_update (xs@x#Γ) var x)))" fix x define X where "X=xs@x#Γ" have Xlength : "length X > var" using X_def hlength by auto define Aval where "Aval = insertion (nth_default 0 (list_update X var x)) A" define Bval where "Bval = insertion (nth_default 0 (list_update X var x)) B" define Cval where "Cval = insertion (nth_default 0 (list_update X var x)) C" have allAval : "∀x. insertion (nth_default 0 (list_update X var x)) A = Aval" using freeA Aval_def using not_contains_insertion by blast have allBval : "∀x. insertion (nth_default 0 (list_update X var x)) B = Bval" using freeB Bval_def using not_contains_insertion by blast have allCval : "∀x. insertion (nth_default 0 (list_update X var x)) C = Cval" using freeC Cval_def using not_contains_insertion by blast assume "(eval (elimVar var L F (Eq p)) (list_update (xs@x#Γ) var x))" then have h : "(eval (elimVar var L F (Eq p)) (list_update X var x))" unfolding X_def . have "(Aval = 0 ∧ Bval ≠ 0 ∧ (∀f∈(λa. Atom(linear_substitution var (-C) B a)) ` set L ∪ linear_substitution_fm var (-C) B ` set F. eval f (X[var := x])) ∨ Aval ≠ 0 ∧ insertion (nth_default 0 (X[var := x])) 4 * Aval * Cval ≤ Bval⇧2 ∧ ((∀f∈(quadratic_sub var (-B) 1 (B^2-4*A*C) (2*A)) ` set L ∪ (quadratic_sub_fm var (-B) 1 (B^2-4*A*C) (2*A)) ` set F. eval f (X[var := x])) ∨(∀f∈(quadratic_sub var (-B) (-1) (B^2-4*A*C) (2*A)) ` set L ∪ (quadratic_sub_fm var (-B) (-1) (B^2-4*A*C) (2*A)) ` set F. eval f (X[var := x])) ))" unfolding Aval_def Bval_def Cval_def A_def B_def C_def using h by(simp add: eval_list_conj insertion_mult insertion_sub insertion_pow insertion_add insertion_var Xlength) then have h : "(Aval = 0 ∧ Bval ≠ 0 ∧ ((∀a∈ set L. aEval (linear_substitution var (-C) B a) (X[var := x])) ∧ (∀a∈ set F. eval (linear_substitution_fm var (-C) B a) (X[var := x]))) ∨ Aval ≠ 0 ∧ insertion (nth_default 0 (X[var := x])) 4 * Aval * Cval ≤ Bval⇧2 ∧ (((∀a∈ set L. eval (quadratic_sub var (-B) 1 (B^2-4*A*C) (2*A) a) (X[var := x])) ∧(∀a∈ set F. eval (quadratic_sub_fm var (-B) 1 (B^2-4*A*C) (2*A) a) (X[var := x]))) ∨((∀a∈ set L. eval (quadratic_sub var (-B) (-1) (B^2-4*A*C) (2*A) a) (X[var := x])) ∧(∀a∈ set F. eval (quadratic_sub_fm var (-B) (-1) (B^2-4*A*C) (2*A) a) (X[var := x]))))) " apply(cases "Aval = 0 ") apply auto by (meson Un_iff eval.simps(1) imageI) have h : "(∃x. ((∀a∈set L . aEval a ((xs@x#Γ)[var := x])) ∧ (∀f∈set F. eval f ((xs@x#Γ)[var := x]))))∨(Aval=0∧Bval=0∧Cval=0)" proof(cases "Aval=0") case True then have aval0 : "Aval=0" by simp show ?thesis proof(cases "Bval = 0") case True then have bval0 : "Bval = 0" by simp show ?thesis proof(cases "Cval=0") case True then show ?thesis using aval0 bval0 True by auto next case False then show ?thesis using h by(simp add:aval0 bval0 False) qed next case False have hb : "insertion (nth_default 0 (X[var := - Cval / Bval])) B = Bval" using allBval by simp have hc : "insertion (nth_default 0 (X[var := - Cval / Bval])) (-C) = -Cval" using allCval by (simp add: insertion_neg) have freecneg : "var∉vars(-C)" using freeC not_in_neg by auto have p1 : "(∀a∈set L. aEval a ((xs @ x # Γ)[var := - Cval / Bval]))" using h apply(simp add: False aval0) using linear[OF Xlength False freecneg freeB hc hb] list_update_length var_not_in_linear[OF freecneg freeB] unfolding X_def using hlength by (metis divide_minus_left) have p2 : "(∀a∈set F. eval a ((xs @ x # Γ)[var := - Cval / Bval]))" using h apply(simp add: False aval0) using linear_fm[OF Xlength False freecneg freeB hc hb] list_update_length var_not_in_linear_fm[OF freecneg freeB] unfolding X_def using hlength var_not_in_eval by (metis divide_minus_left linear_substitution_fm.elims linear_substitution_fm_helper.elims) show ?thesis using p1 p2 hlength by fastforce qed next case False then have aval0 : "Aval ≠ 0" by simp have h4 : "insertion (nth_default 0 (X[var := x])) 4 = 4" using insertion_const[where f = "(nth_default 0 (X[var := x]))", where c="4"] by (metis MPoly_Type.insertion_one insertion_add numeral_Bit0 one_add_one) show ?thesis proof(cases "4 * Aval * Cval ≤ Bval⇧2") case True then have h1 : "- Bval⇧2 + 4 * Aval * Cval ≤ 0" by simp have h : "(((∀a∈ set L. eval (quadratic_sub var (-B) 1 (B^2-4*A*C) (2*A) a) (X[var := x])) ∧(∀a∈ set F. eval (quadratic_sub_fm var (-B) 1 (B^2-4*A*C) (2*A) a) (X[var := x]))) ∨((∀a∈ set L. eval (quadratic_sub var (-B) (-1) (B^2-4*A*C) (2*A) a) (X[var := x])) ∧(∀a∈ set F. eval (quadratic_sub_fm var (-B) (-1) (B^2-4*A*C) (2*A) a) (X[var := x]))))" using h by(simp add: h1 aval0) have h1a : "var∉vars(-B)" by(simp add: freeB not_in_neg) have h1b : "var∉vars(1::real mpoly)" using isolate_var_one not_in_isovarspar by blast have h1c : "var∉vars(-1::real mpoly)" by(simp add: h1b not_in_neg) have h1d : "var∉vars(4::real mpoly)" by (metis h1b not_in_add numeral_Bit0 one_add_one) have h1e : "var∉vars(B^2-4*A*C)" by(simp add: freeB h1d freeA freeC not_in_mult not_in_pow not_in_sub) have h1f : "var∉vars(2::real mpoly)" using h1b not_in_add by fastforce have h1g : "var∉vars(2*A)" by(simp add: freeA h1f not_in_mult) have h1h : "freeIn var (quadratic_sub var (-B) (1) (B^2-4*A*C) (2*A) a)" using free_in_quad h1a h1b h1e h1g by blast have h1i : "freeIn var (quadratic_sub var (-B) (-1) (B^2-4*A*C) (2*A) a)" using free_in_quad h1a h1c h1e h1g by blast have h2 : "2*Aval ≠ 0" using aval0 by auto have h3 : "0 ≤ (Bval^2-4*Aval*Cval)" using True by auto have h4a : "var ∉ vars 4" by (metis monom_numeral notInKeys_notInVars not_in_add not_in_isovarspar not_in_pow one_add_one power.simps(1) rel_simps(76) vars_monom_keys) have h4 : "var ∉ vars (B^2-4*A*C)" by(simp add: h4a freeA freeB freeC not_in_pow not_in_mult not_in_sub) have h5 : "∀x. insertion (nth_default 0 (list_update X var x)) (-B) = -Bval " using allBval by(simp add: insertion_neg) have h6 : "∀x. insertion (nth_default 0 (list_update X var x)) 1 = 1" by simp have h6a : "∀x. insertion (nth_default 0 (list_update X var x)) (-1) = (-1)" using h6 by (simp add: insertion_neg) have h7a : "∀x. insertion (nth_default 0 (list_update X var x)) 4 = 4" by (metis h6 insertion_add numeral_Bit0 one_add_one) have h7b : "var ∉ vars(4*A*C)" using freeA freeC by (simp add: h4a not_in_mult) have h7c : "var ∉ vars(B^2)" using freeB not_in_pow by auto have h7 : "∀x. insertion (nth_default 0 (list_update X var x)) (B^2-4*A*C) = (Bval^2-4*Aval*Cval)" by (simp add: h7a allAval allBval allCval insertion_mult insertion_sub power2_eq_square) have h8a : "∀x. insertion (nth_default 0 (list_update X var x)) 2 = 2" by (metis h6 insertion_add one_add_one) have h8 : "∀x. insertion (nth_default 0 (list_update X var x)) (2*A) = (2*Aval)" by(simp add: allAval h8a insertion_mult) have p1 : "(∀a∈ set L. eval (quadratic_sub var (-B) 1 (B^2-4*A*C) (2*A) a) (X[var := x])) ⟹(∀a∈ set F. eval (quadratic_sub_fm var (-B) 1 (B^2-4*A*C) (2*A) a) (X[var := x])) ⟹ ∃x. length xs = var ∧ ((∀a∈set L . aEval a ((xs@x#Γ)[var := x])) ∧ (∀f∈set F. eval f ((xs@x#Γ)[var := x])))" proof- assume p1 : "(∀a∈ set L. eval (quadratic_sub var (-B) 1 (B^2-4*A*C) (2*A) a) (X[var := x]))" assume p2 : "(∀a∈ set F. eval (quadratic_sub_fm var (-B) 1 (B^2-4*A*C) (2*A) a) (X[var := x]))" show ?thesis using free_in_quad[where a="-B",where b="1", where c="(B^2-4*A*C)", where d="2*A",where var="var",OF h1a h1b h1e h1g] using quadratic_sub[where a="-B",where b="1", where c="(B^2-4*A*C)", where d="2*A",where var="var", where L="X", OF Xlength, where Dv="2*Aval", OF h2, where Cv="(Bval^2-4*Aval*Cval)", OF h3, where Av="-Bval", OF h4 h5, where Bv="1", OF h6 h7 h8] using free_in_quad_fm[where a="-B",where b="1", where c="(B^2-4*A*C)", where d="2*A",where var="var",OF h1a h1b h1e h1g] using quadratic_sub_fm[where a="-B",where b="1", where c="(B^2-4*A*C)", where d="2*A",where var="var", where L="X", OF Xlength, where Dv="2*Aval", OF h2, where Cv="(Bval^2-4*Aval*Cval)", OF h3, where Av="-Bval", OF h4 h5, where Bv="1", OF h6 h7 h8] p1 p2 using var_not_in_eval by (metis X_def hlength list_update_length) qed have p2 : "(∀a∈ set L. eval (quadratic_sub var (-B) (-1) (B^2-4*A*C) (2*A) a) (X[var := x])) ⟹(∀a∈ set F. eval (quadratic_sub_fm var (-B) (-1) (B^2-4*A*C) (2*A) a) (X[var := x])) ⟹∃x. length xs = var ∧ ((∀a∈set L . aEval a ((xs@x#Γ)[var := x])) ∧ (∀f∈set F. eval f ((xs@x#Γ)[var := x])))" using free_in_quad[where a="-B",where b="-1", where c="(B^2-4*A*C)", where d="2*A",where var="var",OF h1a h1c h1e h1g] using quadratic_sub[where a="-B",where b="-1", where c="(B^2-4*A*C)", where d="2*A",where var="var", where L="X", OF Xlength, where Dv="2*Aval", OF h2, where Cv="(Bval^2-4*Aval*Cval)", OF h3, where Av="-Bval", OF h4 h5, where Bv="-1", OF h6a h7 h8] using free_in_quad_fm[where a="-B",where b="-1", where c="(B^2-4*A*C)", where d="2*A",where var="var",OF h1a h1c h1e h1g] using quadratic_sub_fm[where a="-B",where b="-1", where c="(B^2-4*A*C)", where d="2*A",where var="var", where L="X", OF Xlength, where Dv="2*Aval", OF h2, where Cv="(Bval^2-4*Aval*Cval)", OF h3, where Av="-Bval", OF h4 h5, where Bv="-1", OF h6a h7 h8] using var_not_in_eval by (metis X_def hlength list_update_length) then show ?thesis using h p1 p2 by blast next case False then show ?thesis using h by(simp add: aval0 False h4) qed qed have "(∃x.((∀a∈set L . aEval a ((xs@x#Γ)[var := x])) ∧ (∀f∈set F. eval f ((xs@x#Γ)[var := x]))))∨(∀x. aEval (Eq p) (xs @ x#Γ))" proof(cases "(∃x.((∀a∈set L . aEval a ((xs@x#Γ)[var := x])) ∧ (∀f∈set F. eval f ((xs@x#Γ)[var := x]))))") case True then show ?thesis by auto next case False then have "Aval=0∧Bval=0∧Cval=0" using h by auto then have "(∀x. aEval (Eq p) (xs @ x # Γ))" unfolding express_p apply(simp add:insertion_add insertion_mult insertion_pow) using allAval allBval allCval hlength unfolding X_def by auto then show ?thesis by auto qed } then have right : "(∃x. eval (elimVar var L F (Eq p)) (xs @ x # Γ)) ⟹ ((∃x. eval (list_conj (map fm.Atom L @ F)) (xs @ x # Γ))∨(∀x. aEval (Eq p) (xs @ x # Γ)))" by (smt UnE eval.simps(1) eval_list_conj hlength imageE list_update_length set_append set_map) show ?thesis using right left by blast qed text "simply states that the variable is free in the equality case of the elimVar function" lemma freeIn_elimVar_eq : "freeIn var (elimVar var L F (Eq p))" proof- have h4 : "var ∉ vars(4:: real mpoly)" using var_not_in_Const by (metis (full_types) isolate_var_one monom_numeral not_in_isovarspar numeral_One vars_monom_keys zero_neq_numeral) have hlinear: "∀f∈set(map (λa. Atom(linear_substitution var (-isolate_variable_sparse p var 0) (isolate_variable_sparse p var (Suc 0)) a)) L @ map (linear_substitution_fm var (-isolate_variable_sparse p var 0) (isolate_variable_sparse p var (Suc 0))) F). freeIn var f" using var_not_in_linear[where c="(isolate_variable_sparse p var (Suc 0))", where b="(- isolate_variable_sparse p var 0)", where var="var"] var_not_in_linear_fm[where c="(isolate_variable_sparse p var (Suc 0))", where b="(-isolate_variable_sparse p var 0)", where var="var"] not_in_isovarspar not_in_neg by auto have freeA : "var ∉ vars (- isolate_variable_sparse p var (Suc 0))" using not_in_isovarspar not_in_neg by auto have freeB1 : "var ∉ vars (1::real mpoly)" by (metis h4 monom_numeral monom_one notInKeys_notInVars vars_monom_keys zero_neq_numeral) have freeC : "var ∉ vars (((isolate_variable_sparse p var (Suc 0))⇧2 - 4 * isolate_variable_sparse p var 2 * isolate_variable_sparse p var 0))" using not_in_isovarspar not_in_pow not_in_sub not_in_mult h4 by auto have freeD : "var ∉ vars ((2 * isolate_variable_sparse p var 2))" using not_in_isovarspar not_in_mult by (metis mult_2 not_in_add) have freeB2 : "var∉vars (-1::real mpoly)" using freeB1 not_in_neg by auto have quadratic1 : "∀f∈set(map (quadratic_sub var (- isolate_variable_sparse p var (Suc 0)) 1 ((isolate_variable_sparse p var (Suc 0))⇧2 - 4 * isolate_variable_sparse p var 2 * isolate_variable_sparse p var 0) (2 * isolate_variable_sparse p var 2)) L @ map (quadratic_sub_fm var (- isolate_variable_sparse p var (Suc 0)) 1 ((isolate_variable_sparse p var (Suc 0))⇧2 - 4 * isolate_variable_sparse p var 2 * isolate_variable_sparse p var 0) (2 * isolate_variable_sparse p var 2)) F). freeIn var f" using free_in_quad[OF freeA freeB1 freeC freeD] free_in_quad_fm[OF freeA freeB1 freeC freeD] by auto have quadratic2 : "∀f∈set(map (quadratic_sub var (- isolate_variable_sparse p var (Suc 0)) (-1) ((isolate_variable_sparse p var (Suc 0))⇧2 - 4 * isolate_variable_sparse p var 2 * isolate_variable_sparse p var 0) (2 * isolate_variable_sparse p var 2)) L @ map (quadratic_sub_fm var (- isolate_variable_sparse p var (Suc 0)) (-1) ((isolate_variable_sparse p var (Suc 0))⇧2 - 4 * isolate_variable_sparse p var 2 * isolate_variable_sparse p var 0) (2 * isolate_variable_sparse p var 2)) F). freeIn var f" using free_in_quad[OF freeA freeB2 freeC freeD] free_in_quad_fm[OF freeA freeB2 freeC freeD] by auto show ?thesis using not_in_mult not_in_add h4 not_in_pow not_in_sub freeIn_list_conj not_in_isovarspar hlinear quadratic1 quadratic2 by(simp add: ) qed text "Theorem 20.2 in the textbook" lemma elimVar_eq_2 : assumes hlength : "length xs = var" assumes in_list : "Eq p ∈ set(L)" assumes low_pow : "MPoly_Type.degree p var = 1 ∨ MPoly_Type.degree p var = 2" assumes nonzero : "∀x. insertion (nth_default 0 (xs @ x # Γ)) (isolate_variable_sparse p var 2) ≠ 0 ∨ insertion (nth_default 0 (xs @ x # Γ)) (isolate_variable_sparse p var 1) ≠ 0 ∨ insertion (nth_default 0 (xs @ x # Γ)) (isolate_variable_sparse p var 0) ≠ 0" (is ?non0) shows "(∃x. eval (list_conj (map fm.Atom L @ F)) (xs @ x # Γ)) = (∃x. eval (elimVar var L F (Eq p)) (xs @ x # Γ))" proof- define A where "A = (isolate_variable_sparse p var 2)" define B where "B = (isolate_variable_sparse p var 1)" define C where "C = (isolate_variable_sparse p var 0)" have freeA : "var ∉ vars A" unfolding A_def by (simp add: not_in_isovarspar) have freeB : "var ∉ vars B" unfolding B_def by (simp add: not_in_isovarspar) have freeC : "var ∉ vars C" unfolding C_def by (simp add: not_in_isovarspar) have express_p : "p = A*(Var var)^2+B*(Var var)+C" using express_poly[OF low_pow] unfolding A_def B_def C_def by fastforce have af : "isolate_variable_sparse p var 2 = A" using A_def by auto have bf : "isolate_variable_sparse p var (Suc 0) = B" using B_def by auto have cf : "isolate_variable_sparse p var 0 = C" using C_def by auto have xlength : "∀x. (insertion (nth_default 0 (xs @ x # Γ)) (Var var))= x" using hlength insertion_var by (metis add.commute add_strict_increasing length_append length_greater_0_conv list.distinct(1) list_update_id nth_append_length order_refl) fix x define c where "c i = (insertion (nth_default 0 (xs @ x # Γ)) (isolate_variable_sparse p var i))" for i have c2 : "∀x. insertion (nth_default 0 (xs @ x # Γ)) A = c 2" using freeA apply(simp add: A_def c_def) by (simp add: hlength insertion_lowerPoly1) have c1 : "∀x. insertion (nth_default 0 (xs @ x # Γ)) B = c 1" using freeB apply(simp add: B_def c_def) by (simp add: hlength insertion_lowerPoly1) have c0 : "∀x. insertion (nth_default 0 (xs @ x # Γ)) C = c 0" using freeC apply(simp add: C_def c_def) by (simp add: hlength insertion_lowerPoly1) have sum : "∀x. c 2 * x⇧2 + c (Suc 0) * x + c 0 = (∑i≤2. c i * x ^ i)" by (simp add: numerals(2)) have "(∀x. aEval (Eq p) (xs @ x # Γ)) = (¬?non0)" apply(simp add : af bf cf) unfolding express_p apply(simp add:insertion_add insertion_mult insertion_pow xlength) apply(simp add:c2 c1 c0) apply(simp add: sum) using polyfun_eq_0[where c="c", where n="2"] using sum by auto then have "¬(∀x. aEval (Eq p) (xs @ x Γ))" using nonzero by auto then show ?thesis using disjE[OF elimVar_eq[OF hlength in_list, where F="F", where Γ="Γ"], where R="?thesis"] using ‹(∀x. aEval (Eq p) (xs @ x # Γ)) = (¬ (∀x. insertion (nth_default 0 (xs @ x # Γ)) (isolate_variable_sparse p var 2) ≠ 0 ∨ insertion (nth_default 0 (xs @ x # Γ)) (isolate_variable_sparse p var 1) ≠ 0 ∨ insertion (nth_default 0 (xs @ x # Γ)) (isolate_variable_sparse p var 0) ≠ 0))› low_pow nonzero by blast qed end
subsection "Overall LuckyFind Proofs" theory LuckyFind imports EliminateVariable begin theorem luckyFind_eval: assumes "luckyFind x L F = Some F'" assumes "length xs = x" shows "(∃x. (eval (list_conj ((map Atom L) @ F)) (xs @ (x#Γ)))) = (∃x.(eval F' (xs @ (x#Γ))))" proof(cases "find_lucky_eq x L") case None then show ?thesis using assms by auto next case (Some p) have inset : "Eq p ∈ set L" using Some proof(induction L) case Nil then show ?case by auto next case (Cons a L) then show ?case proof(cases a) case (Less x1) then show ?thesis using Cons by auto next case (Eq p') show ?thesis using Cons unfolding Eq apply simp apply(cases "(MPoly_Type.degree p' x = Suc 0 ∨ MPoly_Type.degree p' x = 2)") apply simp_all apply(cases "check_nonzero_const (isolate_variable_sparse p' x 2)") apply(simp_all) apply(cases "check_nonzero_const (isolate_variable_sparse p' x 1)") apply(simp_all) apply(cases "check_nonzero_const (isolate_variable_sparse p' x 0)") by(simp_all) next case (Leq x3) then show ?thesis using Cons by auto next case (Neq x4) then show ?thesis using Cons by auto qed qed have degree : "MPoly_Type.degree p x = 1 ∨ MPoly_Type.degree p x = 2" using Some proof(induction L) case Nil then show ?case by auto next case (Cons a L) then show ?case proof(cases a) case (Less x1) then show ?thesis using Cons by auto next case (Eq p') show ?thesis using Cons unfolding Eq apply simp apply(cases "(MPoly_Type.degree p' x = Suc 0 ∨ MPoly_Type.degree p' x = 2)") apply simp_all apply(cases "check_nonzero_const (isolate_variable_sparse p' x 2)") apply(simp_all) apply(cases "check_nonzero_const (isolate_variable_sparse p' x 1)") apply(simp_all) apply(cases "check_nonzero_const (isolate_variable_sparse p' x 0)") by(simp_all) next case (Leq x3) then show ?thesis using Cons by auto next case (Neq x4) then show ?thesis using Cons by auto qed qed have nonzero : "∀xa. insertion (nth_default 0 (xs @ xa # Γ)) (isolate_variable_sparse p x 2) ≠ 0 ∨ insertion (nth_default 0 (xs @ xa # Γ)) (isolate_variable_sparse p x 1) ≠ 0 ∨ insertion (nth_default 0 (xs @ xa # Γ)) (isolate_variable_sparse p x 0) ≠ 0" using Some proof(induction L) case Nil then show ?case by auto next case (Cons a L) then show ?case proof(cases a) case (Less x1) then show ?thesis using Cons by auto next case (Eq p') have h : "⋀p xa. check_nonzero_const p ⟹ insertion (nth_default 0 (xs @ xa # Γ)) p ≠ 0" proof- fix p xa assume h : "check_nonzero_const p" show "insertion (nth_default 0 (xs @ xa # Γ)) p ≠ 0" apply(cases "get_if_const p") using h get_if_const_insertion by simp_all qed show ?thesis using Cons(2) unfolding Eq apply (simp del:get_if_const.simps) apply(cases "(MPoly_Type.degree p' x = Suc 0 ∨ MPoly_Type.degree p' x = 2)") defer using Cons apply simp apply (simp del:get_if_const.simps) apply(cases "check_nonzero_const (isolate_variable_sparse p' x 2)") apply(simp del:get_if_const.simps) using h apply simp apply(cases "check_nonzero_const (isolate_variable_sparse p' x 1)") apply(simp del:get_if_const.simps) using h apply simp apply(cases "check_nonzero_const (isolate_variable_sparse p' x 0)") apply(simp del:get_if_const.simps) using h apply simp using Cons by auto next case (Leq x3) then show ?thesis using Cons by auto next case (Neq x4) then show ?thesis using Cons by auto qed qed show ?thesis using elimVar_eq_2[OF assms(2) inset degree nonzero] Some assms by auto qed lemma luckyFind'_eval : assumes "length xs = var" shows "(∃x. eval (list_conj (map fm.Atom L @ F)) (xs @ x # Γ)) = (∃x. eval (luckyFind' var L F) (xs @ x # Γ))" proof(cases "find_lucky_eq var L") case None show ?thesis apply(simp add:eval_list_conj None) apply(rule ex_cong1) apply auto by (meson UnCI eval.simps(1) image_eqI) next case (Some p) have "∃F'. luckyFind var L F = Some F'" by (simp add:Some) then obtain F' where F'_def: "luckyFind var L F = Some F'" by metis show ?thesis unfolding luckyFind_eval[OF F'_def assms] using F'_def Some by auto qed lemma luckiestFind_eval : assumes "length xs = var" shows "(∃x. eval (list_conj (map fm.Atom L @ F)) (xs @ x # Γ)) = (∃x. eval (luckiestFind var L F) (xs @ x # Γ))" proof(cases "find_luckiest_eq var L") case None show ?thesis apply(simp add:eval_list_conj None) apply(rule ex_cong1) apply auto by (meson UnCI eval.simps(1) image_eqI) next case (Some p) have h1: "Eq p ∈ set L" using Some apply(induction L arbitrary:p) apply simp subgoal for a L p apply(rule find_luckiest_eq.elims[of var "a#L" "Some p"]) apply simp_all subgoal for v p' apply(cases "MPoly_Type.degree p' v = Suc 0 ∨ MPoly_Type.degree p' v = 2") apply simp_all apply(cases "Set.is_empty (vars (isolate_variable_sparse p' v 2))") apply simp_all apply(cases "Set.is_empty (vars (isolate_variable_sparse p' v (Suc 0)))") apply simp_all apply(cases "Set.is_empty (vars (isolate_variable_sparse p' v 0))") apply simp_all apply(cases "MPoly_Type.coeff (isolate_variable_sparse p' v (Suc 0)) 0 = 0 ⟶ MPoly_Type.coeff (isolate_variable_sparse p' v 2) 0 = 0 ⟶ MPoly_Type.coeff (isolate_variable_sparse p' v 0) 0 ≠ 0") by simp_all done done have h2 : "MPoly_Type.degree p var = 1 ∨ MPoly_Type.degree p var = 2" using Some apply(induction L arbitrary:p) apply simp subgoal for a L p apply(rule find_luckiest_eq.elims[of var "a#L" "Some p"]) apply simp_all subgoal for v p' apply(cases "MPoly_Type.degree p' v = Suc 0 ∨ MPoly_Type.degree p' v = 2") apply simp_all apply(cases "Set.is_empty (vars (isolate_variable_sparse p' v 2))") apply simp_all apply(cases "Set.is_empty (vars (isolate_variable_sparse p' v (Suc 0)))") apply simp_all apply(cases "Set.is_empty (vars (isolate_variable_sparse p' v 0))") apply simp_all apply(cases "MPoly_Type.coeff (isolate_variable_sparse p' v (Suc 0)) 0 = 0 ⟶ MPoly_Type.coeff (isolate_variable_sparse p' v 2) 0 = 0 ⟶ MPoly_Type.coeff (isolate_variable_sparse p' v 0) 0 ≠ 0") by simp_all done done have h : "⋀p xa. check_nonzero_const p ⟹ insertion (nth_default 0 (xs @ xa # Γ)) p ≠ 0" proof- fix p xa assume h : "check_nonzero_const p" show "insertion (nth_default 0 (xs @ xa # Γ)) p ≠ 0" apply(cases "get_if_const p") using h get_if_const_insertion by simp_all qed have h3 : "∀x. insertion (nth_default 0 (xs @ x # Γ)) (isolate_variable_sparse p var 2) ≠ 0 ∨ insertion (nth_default 0 (xs @ x # Γ)) (isolate_variable_sparse p var 1) ≠ 0 ∨ insertion (nth_default 0 (xs @ x # Γ)) (isolate_variable_sparse p var 0) ≠ 0" using Some apply(induction L arbitrary:p) apply simp subgoal for a L p apply(rule find_luckiest_eq.elims[of var "a#L" "Some p"]) apply simp_all subgoal for v p' apply(cases "MPoly_Type.degree p' v = Suc 0 ∨ MPoly_Type.degree p' v = 2") apply simp_all apply(cases "Set.is_empty (vars (isolate_variable_sparse p' v 2))") apply simp_all apply(cases "Set.is_empty (vars (isolate_variable_sparse p' v (Suc 0)))") apply simp_all apply(cases "Set.is_empty (vars (isolate_variable_sparse p' v 0))") apply simp_all apply(cases "MPoly_Type.coeff (isolate_variable_sparse p' v (Suc 0)) 0 = 0 ⟶ MPoly_Type.coeff (isolate_variable_sparse p' v 2) 0 = 0 ⟶ MPoly_Type.coeff (isolate_variable_sparse p' v 0) 0 ≠ 0") apply simp_all using h[of "isolate_variable_sparse p' v 0"] h[of "isolate_variable_sparse p' v (Suc 0)"] h[of "isolate_variable_sparse p' v 2"] apply simp by blast done done show ?thesis apply(simp_all add:Some del:elimVar.simps) apply(rule elimVar_eq_2) using assms apply simp using h1 h2 h3 by auto qed end
subsection "Overall Equality VS Proofs" theory EqualityVS imports EliminateVariable LuckyFind begin lemma degree_find_eq : assumes "find_eq var L = (A,L')" shows "∀p∈set(A). MPoly_Type.degree p var = 1 ∨ MPoly_Type.degree p var = 2" using assms(1) proof(induction L arbitrary: A L') case Nil then show ?case by auto next case (Cons a L) then show ?case proof(cases a) case (Less p) {fix A' L' assume h : "find_eq var L = (A', L')" have "A=A'" using Less Cons h by(simp) then have "∀p∈set A. MPoly_Type.degree p var = 1 ∨ MPoly_Type.degree p var = 2" using Cons h by auto } then show ?thesis by (meson surj_pair) next case (Eq p) then show ?thesis proof(cases "MPoly_Type.degree p var = 1 ∨ MPoly_Type.degree p var = 2") case True {fix A' L' assume h : "find_eq var L = (A', L')" have "A= (p#A')" using Eq Cons h True by auto then have "∀p∈set A. MPoly_Type.degree p var = 1 ∨ MPoly_Type.degree p var = 2" using Cons h True by auto } then show ?thesis by (meson surj_pair) next case False {fix A' L' assume h : "find_eq var L = (A', L')" have "A=A'" using Eq Cons h False by (smt One_nat_def case_prod_conv find_eq.simps(3) less_2_cases less_SucE numeral_2_eq_2 numeral_3_eq_3 prod.sel(1)) then have "∀p∈set A. MPoly_Type.degree p var = 1 ∨ MPoly_Type.degree p var = 2" using Cons h by auto } then show ?thesis by (meson surj_pair) qed next case (Leq p) {fix A' L' assume h : "find_eq var L = (A', L')" have "A=A'" using Leq Cons h by(simp) then have "∀p∈set A. MPoly_Type.degree p var = 1 ∨ MPoly_Type.degree p var = 2" using Cons h by auto } then show ?thesis by (meson surj_pair) next case (Neq p) {fix A' L' assume h : "find_eq var L = (A', L')" have "A=A'" using Neq Cons h by(simp) then have "∀p∈set A. MPoly_Type.degree p var = 1 ∨ MPoly_Type.degree p var = 2" using Cons h by auto } then show ?thesis by (meson surj_pair) qed qed lemma list_in_find_eq : assumes "find_eq var L = (A,L')" shows "set(map Eq A @ L') = set L"using assms(1) proof(induction L arbitrary: A L') case Nil then show ?case by auto next case (Cons a L) then show ?case proof(cases a) case (Less p) {fix A' L'' assume h : "find_eq var L = (A', L'')" have A : "A=A'" using Less Cons h by(simp) have L : "L'=Less p # L''" using Less Cons h by simp have "set (map Eq A @ L') = set (a # L)" apply(simp add: A L Less) using Cons(1)[OF h] by auto } then show ?thesis by (meson surj_pair) next case (Eq p) then show ?thesis proof(cases "MPoly_Type.degree p var = 1 ∨ MPoly_Type.degree p var = 2") case True {fix A' L'' assume h : "find_eq var L = (A', L'')" have A : "A=(p#A')" using Eq Cons h True by auto have L : "L'= L''" using Eq Cons h True by auto have "set (map Eq A @ L') = set (a # L)" apply(simp add: A L Eq) using Cons(1)[OF h] by auto } then show ?thesis by (meson surj_pair) next case False {fix A' L'' assume h : "find_eq var L = (A', L'')" have A : "A=A'" using Eq Cons h False by (smt case_prod_conv degree_find_eq find_eq.simps(3) list.set_intros(1) prod.sel(1)) have L : "L'=Eq p # L''" using Eq Cons h by (smt A case_prod_conv find_eq.simps(3) not_Cons_self2 prod.sel(1) prod.sel(2)) have "set (map Eq A @ L') = set (a # L)" apply(simp add: A L Eq) using Cons(1)[OF h] by auto } then show ?thesis by (meson surj_pair) qed next case (Leq p) {fix A' L'' assume h : "find_eq var L = (A', L'')" have A : "A=A'" using Leq Cons h by(simp) have L : "L'=Leq p # L''" using Leq Cons h by simp have "set (map Eq A @ L') = set (a # L)" apply(simp add: A L Leq) using Cons(1)[OF h] by auto } then show ?thesis by (meson surj_pair) next case (Neq p) {fix A' L'' assume h : "find_eq var L = (A', L'')" have A : "A=A'" using Neq Cons h by(simp) have L : "L'=Neq p # L''" using Neq Cons h by simp have "set (map Eq A @ L') = set (a # L)" apply(simp add: A L Neq) using Cons(1)[OF h] by auto } then show ?thesis by (meson surj_pair) qed qed lemma qe_eq_one_eval : assumes hlength : "length xs = var" shows "(∃x. (eval (list_conj ((map Atom L) @ F)) (xs @ (x#Γ)))) = (∃x.(eval (qe_eq_one var L F) (xs @ (x#Γ))))" proof(cases "find_eq var L") case (Pair A L') then show ?thesis proof(cases A) case Nil show ?thesis proof safe fix x assume h : "eval (list_conj (map fm.Atom L @ F)) (xs @ x # Γ)" show "∃x. eval (qe_eq_one var L F) (xs @ x # Γ)" apply(simp) using Nil Pair h by auto next fix x assume h : "eval (qe_eq_one var L F) (xs @ x # Γ)" show "∃x. eval (list_conj (map fm.Atom L @ F)) (xs @ x # Γ)" apply(rule exI[where x="x"]) using Nil Pair h by auto qed next case (Cons p A') have "set(map Eq (p # A') @ L') = set L" using list_in_find_eq[OF Pair] Cons by auto then have in_p: "Eq p ∈ set (L)" by auto have "p∈(set A)" using Cons by auto then have low_pow : "MPoly_Type.degree p var = 1 ∨ MPoly_Type.degree p var = 2" using degree_find_eq[OF Pair] by auto have "(∃x.(eval (qe_eq_one var L F) (xs @ (x#Γ)))) = (∃x.(eval (Or (And (Neg (split_p var p)) ((elimVar var L F) (Eq p)) ) (And (split_p var p) (list_conj (map Atom ((map Eq A') @ L') @ F)) )) (xs @ (x#Γ))))" apply(rule ex_cong1) apply(simp only: qe_eq_one.simps) using Pair Cons by auto also have "... = (∃x. ((¬eval (split_p var p) (xs @ x # Γ)) ∧ eval (elimVar var L F (Eq p)) (xs @ x # Γ)) ∨ eval (split_p var p) (xs @ x # Γ) ∧ (∀f∈set (map fm.Atom (map Eq A' @ L') @ F). eval f (xs @ x # Γ)))" by(simp add: eval_list_conj) also have "... = (∃x. eval (list_conj (map fm.Atom L @ F)) (xs @ x # Γ))" proof(cases "∀x. insertion (nth_default 0 (xs @ x # Γ)) (isolate_variable_sparse p var 2) ≠ 0 ∨ insertion (nth_default 0 (xs @ x # Γ)) (isolate_variable_sparse p var 1) ≠ 0 ∨ insertion (nth_default 0 (xs @ x # Γ)) (isolate_variable_sparse p var 0) ≠ 0") case True have "(∃x. ((¬eval (split_p var p) (xs @ x # Γ)) ∧ eval (elimVar var L F (Eq p)) (xs @ x # Γ)) ∨ eval (split_p var p) (xs @ x # Γ) ∧ (∀f∈set (map fm.Atom (map Eq A' @ L') @ F). eval f (xs @ x # Γ))) = (∃x. eval (elimVar var L F (Eq p)) (xs @ x # Γ))" proof safe fix x assume "eval (elimVar var L F (Eq p)) (xs @ x # Γ)" then show "∃x. eval (elimVar var L F (Eq p)) (xs @ x # Γ)" by auto next fix x assume h : "eval (split_p var p) (xs @ x # Γ)" have "¬ eval (split_p var p) (xs @ x # Γ)" using True by simp then show "∃x. eval (elimVar var L F (Eq p)) (xs @ x # Γ)" using h by simp next fix x assume "eval (elimVar var L F (Eq p)) (xs @ x # Γ)" then show "∃x. ¬ eval (split_p var p) (xs @ x # Γ) ∧ eval (elimVar var L F (Eq p)) (xs @ x # Γ) ∨ eval (split_p var p) (xs @ x # Γ) ∧ (∀f∈set (map fm.Atom (map Eq A' @ L') @ F). eval f (xs @ x # Γ))" by auto qed then show ?thesis using elimVar_eq_2[OF hlength in_p low_pow True] by simp next case False have h1: "∀x. eval (split_p var p) (xs @ x # Γ)" using False apply(simp) using not_in_isovarspar by (metis hlength insertion_lowerPoly1) have "set(map Eq (p # A') @ L') = set L" using list_in_find_eq[OF Pair] Cons by auto then have h5 : "set(map fm.Atom (map Eq (p # A') @ L') @ F) = set(map fm.Atom L @ F)" by auto have h4 : "(∃x. (aEval (Eq p) (xs @ x # Γ)) ∧ (∀f∈set (map fm.Atom (map Eq A' @ L') @ F). eval f (xs @ x # Γ))) = (∃x.(∀f∈set (map fm.Atom (map Eq (p#A') @ L') @ F). eval f (xs @ x # Γ)))" by(simp) have h2 : "(∃x. eval (list_conj (map fm.Atom L @ F)) (xs @ x # Γ)) = (∃x. (aEval (Eq p) (xs @ x # Γ)) ∧ (∀f∈set (map fm.Atom (map Eq A' @ L') @ F). eval f (xs @ x # Γ)))" by(simp only: h4 h5 eval_list_conj) have h3 : "∀x. (aEval (Eq p) (xs @ x # Γ))" proof- define A where "A = (isolate_variable_sparse p var 2)" define B where "B = (isolate_variable_sparse p var 1)" define C where "C = (isolate_variable_sparse p var 0)" have freeA : "var ∉ vars A" unfolding A_def by (simp add: not_in_isovarspar) have freeB : "var ∉ vars B" unfolding B_def by (simp add: not_in_isovarspar) have freeC : "var ∉ vars C" unfolding C_def by (simp add: not_in_isovarspar) have express_p : "p = A*(Var var)^2+B*(Var var)+C" using express_poly[OF low_pow] unfolding A_def B_def C_def by fastforce have xlength : "∀x. (insertion (nth_default 0 (xs @ x # Γ)) (Var var))= x" using hlength insertion_var by (metis add.commute add_strict_increasing length_append length_greater_0_conv list.distinct(1) list_update_id nth_append_length order_refl) fix x define c where "c i = (insertion (nth_default 0 (xs @ x # Γ)) (isolate_variable_sparse p var i))" for i have c2 : "∀x. insertion (nth_default 0 (xs @ x # Γ)) A = c 2" using freeA apply(simp add: A_def c_def) by (simp add: hlength insertion_lowerPoly1) have c1 : "∀x. insertion (nth_default 0 (xs @ x # Γ)) B = c 1" using freeB apply(simp add: B_def c_def) by (simp add: hlength insertion_lowerPoly1) have c0 : "∀x. insertion (nth_default 0 (xs @ x # Γ)) C = c 0" using freeC apply(simp add: C_def c_def) by (simp add: hlength insertion_lowerPoly1) have sum : "∀x. c 2 * x⇧2 + c (Suc 0) * x + c 0 = (∑i≤2. c i * x ^ i)" by (simp add: numerals(2)) show ?thesis unfolding express_p apply(simp add:insertion_add insertion_mult insertion_pow xlength) apply(simp add:c2 c1 c0 sum polyfun_eq_0[where c="c", where n="2"]) using False apply(simp) by (metis A_def B_def C_def One_nat_def c0 c1 c2 le_SucE le_zero_eq numeral_2_eq_2) qed show ?thesis apply(simp only: h1 h2) using h3 by(simp) qed finally show ?thesis by auto qed qed lemma qe_eq_repeat_helper_eval_case1 : assumes hlength : "length xs = var" assumes degreeGood : "∀p∈set(A). MPoly_Type.degree p var = 1 ∨ MPoly_Type.degree p var = 2" shows "((eval (list_conj ((map (Atom o Eq) A) @ (map Atom L) @ F)) (xs @ (x#Γ)))) ⟹ (eval (qe_eq_repeat_helper var A L F) (xs @ x # Γ))" proof(induction A rule : in_list_induct) case Nil then show ?case by auto next case (Cons p A') assume assm : "((eval (list_conj ((map (Atom o Eq) (p#A')) @ (map Atom L) @ F)) (xs @ (x#Γ)))) " then have h : "insertion (nth_default 0 (xs @ x # Γ)) p = 0 ∧ (eval (qe_eq_repeat_helper var A' L F) (xs @ x # Γ))" using Cons by(simp add: eval_list_conj) have "¬ eval (split_p var p) (xs @ x # Γ) ∧ eval (elimVar var ((map Eq (p# A')) @ L) F (Eq p)) (xs @ x # Γ) ∨ eval (split_p var p) (xs @ x # Γ) ∧ eval (qe_eq_repeat_helper var A' L F) (xs @ x # Γ)" proof(cases "eval (split_p var p) (xs @ x # Γ)") case True then show ?thesis using h by blast next case False have all0 : " ∀x. insertion (nth_default 0 (xs @ x # Γ)) (isolate_variable_sparse p var 2) ≠ 0 ∨ insertion (nth_default 0 (xs @ x # Γ)) (isolate_variable_sparse p var 1) ≠ 0 ∨ insertion (nth_default 0 (xs @ x # Γ)) (isolate_variable_sparse p var 0) ≠ 0" using False apply(simp) using not_in_isovarspar by (metis hlength insertion_lowerPoly1) have in_p : "Eq p∈set((map Eq (p # A') @ L))" by auto have "p∈(set A)" using Cons by auto then have low_pow : "MPoly_Type.degree p var = 1 ∨ MPoly_Type.degree p var = 2" using degreeGood by auto have list_manipulate : "map fm.Atom (map Eq (p # A') @ L) = map (fm.Atom ∘ Eq) (p # A') @ map fm.Atom L" by(simp) have "eval (elimVar var ((map Eq (p# A')) @ L) F (Eq p)) (xs @ x # Γ)" using elimVar_eq_2[OF hlength in_p low_pow all0, where F="F"] apply(simp only: list_manipulate) using assm freeIn_elimVar_eq[where var="var", where L="(map Eq (p # A') @ L)", where F="F", where p="p"] by (metis append.assoc hlength list_update_length var_not_in_eval) then show ?thesis apply(simp only: False) by blast qed then show ?case by(simp only: qe_eq_repeat_helper.simps eval.simps) qed lemma qe_eq_repeat_helper_eval_case2 : assumes hlength : "length xs = var" assumes degreeGood : "∀p∈set(A). MPoly_Type.degree p var = 1 ∨ MPoly_Type.degree p var = 2" shows "(eval (qe_eq_repeat_helper var A L F) (xs @ x # Γ)) ⟹ ∃x. ((eval (list_conj ((map (Atom o Eq) A) @ (map Atom L) @ F)) (xs @ (x#Γ))))" proof(induction A rule : in_list_induct) case Nil then show ?case apply(simp) apply(rule exI[where x=x]) by simp next case (Cons p A') have h : "¬ eval (split_p var p) (xs @ x # Γ) ∧ eval (elimVar var ((map Eq (p# A')) @ L) F (Eq p)) (xs @ x # Γ) ∨ eval (split_p var p) (xs @ x # Γ) ∧ eval (qe_eq_repeat_helper var A' L F) (xs @ x # Γ)" using Cons by(simp only:qe_eq_repeat_helper.simps eval.simps) have "p∈set(A)" using Cons(1) . then have degp : "MPoly_Type.degree p var = 1 ∨ MPoly_Type.degree p var = 2" using degreeGood by auto show ?case proof(cases "eval (split_p var p) (xs @ x # Γ)") case True have "∃x. eval (list_conj (map (fm.Atom ∘ Eq) A' @ map fm.Atom L @ F)) (xs @ x # Γ)" using h True Cons by blast then obtain x where x_def : "eval (list_conj (map (fm.Atom ∘ Eq) A' @ map fm.Atom L @ F)) (xs @ x # Γ)" by metis define A where "A = (isolate_variable_sparse p var 2)" define B where "B = (isolate_variable_sparse p var 1)" define C where "C = (isolate_variable_sparse p var 0)" have express_p : "p = A * Var var ^2+B * Var var+C" proof(cases "MPoly_Type.degree p var = 1") case True have a0 : "A = 0" apply(simp add: A_def) using True by (simp add: isovar_greater_degree) show ?thesis using sum_over_zero[where mp="p", where x="var"] apply(subst (asm) True) by(simp add:a0 B_def C_def add.commute) next case False then have deg : "MPoly_Type.degree p var = 2" using degp by blast have flip : "A * (Var var)⇧2 + B * Var var + C = C + B * Var var + A * (Var var)^2" using add.commute by auto show ?thesis using sum_over_zero[where mp="p", where x="var"] apply(subst (asm) deg) apply(simp add: flip) apply(simp add: A_def B_def C_def) by (simp add: numeral_2_eq_2) qed have insert_x : "insertion (nth_default 0 (xs @ x # Γ)) (Var var) = x" using hlength by (metis add.commute add_strict_increasing insertion_var length_append length_greater_0_conv list.distinct(1) list_update_id nth_append_length order_refl) have h : "(aEval (Eq p) (xs @ x # Γ))" proof- have freeA : "var ∉ vars A" unfolding A_def by (simp add: not_in_isovarspar) have freeB : "var ∉ vars B" unfolding B_def by (simp add: not_in_isovarspar) have freeC : "var ∉ vars C" unfolding C_def by (simp add: not_in_isovarspar) have xlength : "(insertion (nth_default 0 (xs @ x # Γ)) (Var var))= x" using hlength insertion_var using insert_x by blast define c where "c i = (insertion (nth_default 0 (xs @ x # Γ)) (isolate_variable_sparse p var i))" for i have c2 : "∀x. insertion (nth_default 0 (xs @ x # Γ)) A = c 2" using freeA apply(simp add: A_def c_def) by (simp add: hlength insertion_lowerPoly1) have c1 : "∀x. insertion (nth_default 0 (xs @ x # Γ)) B = c 1" using freeB apply(simp add: B_def c_def) by (simp add: hlength insertion_lowerPoly1) have c0 : "∀x. insertion (nth_default 0 (xs @ x # Γ)) C = c 0" using freeC apply(simp add: C_def c_def) by (simp add: hlength insertion_lowerPoly1) have sum : "c 2 * x⇧2 + c (Suc 0) * x + c 0 = (∑i≤2. c i * x ^ i)" by (simp add: numerals(2)) show ?thesis apply(subst express_p) apply(simp add:insertion_add insertion_mult insertion_pow xlength) apply(simp add:c2 c1 c0 sum polyfun_eq_0[where c="c", where n="2"]) using True apply(simp) using le_SucE numeral_2_eq_2 by (metis (no_types) A_def B_def C_def One_nat_def add.left_neutral c0 c1 c2 mult_zero_class.mult_zero_left sum) qed show ?thesis apply(rule exI[where x=x]) using x_def h apply(simp only:eval_list_conj) by(simp) next case False have all0 : " ∀x. insertion (nth_default 0 (xs @ x # Γ)) (isolate_variable_sparse p var 2) ≠ 0 ∨ insertion (nth_default 0 (xs @ x # Γ)) (isolate_variable_sparse p var 1) ≠ 0 ∨ insertion (nth_default 0 (xs @ x # Γ)) (isolate_variable_sparse p var 0) ≠ 0" using False apply(simp) using not_in_isovarspar by (metis hlength insertion_lowerPoly1) have h : "eval (elimVar var ((map Eq (p# A')) @ L) F (Eq p)) (xs @ x # Γ)" using False h by blast have in_list : "Eq p ∈ set (((map Eq (p# A')) @ L))" by(simp) show ?thesis using elimVar_eq_2[OF hlength in_list, where F="F", OF degp all0] h by (metis append_assoc map_append map_map) qed qed lemma qe_eq_repeat_eval : assumes hlength : "length xs = var" shows "(∃x. (eval (list_conj ((map Atom L) @ F)) (xs @ (x#Γ)))) = (∃x.(eval (qe_eq_repeat var L F) (xs @ (x#Γ))))" proof(cases "luckyFind var L F") case None then show ?thesis proof(cases "find_eq var L") case (Pair A L') have degGood : "∀p∈set A. MPoly_Type.degree p var = 1 ∨ MPoly_Type.degree p var = 2" using degree_find_eq[OF Pair] . have "(∃x. eval (qe_eq_repeat var L F) (xs @ x # Γ)) =(∃x. eval (qe_eq_repeat_helper var A L' F) (xs @ x # Γ))" using Pair None by auto also have "... = (∃x. ((eval (list_conj ((map (Atom o Eq) A) @ (map Atom L') @ F)) (xs @ (x#Γ)))))" using qe_eq_repeat_helper_eval_case1[OF hlength degGood, where L="L'", where F="F", where Γ="Γ"] qe_eq_repeat_helper_eval_case2[OF hlength degGood, where L="L'", where F="F", where Γ="Γ"] by blast also have "... = (∃x. (eval (list_conj ((map Atom L) @ F)) (xs @ (x#Γ))))" proof- have list_manipulate : "map (fm.Atom ∘ Eq) A @ map fm.Atom L' = map fm.Atom (map Eq A @ L')" by simp have changeA : "map (fm.Atom ∘ Eq) A = map Atom (map Eq A)" by auto have split : "(∃x. ∀f∈set ((map (fm.Atom ∘ Eq) A) @ (map fm.Atom L') @ F). eval f (xs @ x # Γ)) = (∃x. ∀f∈ (Atom ` set ((map (Eq) A) @ L')) ∪ set(F). eval f (xs @ x # Γ))" apply (rule ex_cong1) apply(subst changeA) by auto show ?thesis apply(simp only: eval_list_conj split list_in_find_eq[OF Pair]) by auto qed finally have ?thesis by simp then show ?thesis by auto qed next case (Some a) then show ?thesis using luckyFind_eval[OF Some assms(1)] by auto qed end
section "General VS Proofs" subsection "Univariate Atoms" theory UniAtoms imports Debruijn begin datatype atomUni = LessUni "real * real * real" | EqUni "real * real * real" | LeqUni "real * real * real" | NeqUni "real * real * real" datatype (atoms: 'a) fmUni = TrueFUni | FalseFUni | AtomUni 'a | AndUni "'a fmUni" "'a fmUni" | OrUni "'a fmUni" "'a fmUni" fun aEvalUni :: "atomUni ⇒ real ⇒ bool" where "aEvalUni (EqUni (a,b,c)) x = (a*x^2+b*x+c = 0)" | "aEvalUni (LessUni (a,b,c)) x = (a*x^2+b*x+c < 0)" | "aEvalUni (LeqUni (a,b,c)) x = (a*x^2+b*x+c ≤ 0)" | "aEvalUni (NeqUni (a,b,c)) x = (a*x^2+b*x+c ≠ 0)" fun aNegUni :: "atomUni ⇒ atomUni" where "aNegUni (LessUni (a,b,c)) = LeqUni (-a,-b,-c)" | "aNegUni (EqUni p) = NeqUni p" | "aNegUni (LeqUni (a,b,c)) = LessUni (-a,-b,-c)" | "aNegUni (NeqUni p) = EqUni p" fun evalUni :: "atomUni fmUni ⇒ real ⇒ bool" where "evalUni (AtomUni a) x = aEvalUni a x" | "evalUni (TrueFUni) _ = True" | "evalUni (FalseFUni) _ = False" | "evalUni (AndUni φ ψ) x = ((evalUni φ x) ∧ (evalUni ψ x))" | "evalUni (OrUni φ ψ) x = ((evalUni φ x) ∨ (evalUni ψ x))" fun negUni :: "atomUni fmUni ⇒ atomUni fmUni" where "negUni (AtomUni a) = AtomUni(aNegUni a)" | "negUni (TrueFUni) = FalseFUni" | "negUni (FalseFUni) = TrueFUni" | "negUni (AndUni φ ψ) = (OrUni (negUni φ) (negUni ψ))" | "negUni (OrUni φ ψ) = (AndUni (negUni φ) (negUni ψ))" fun convert_poly :: "nat ⇒ real mpoly ⇒ real list ⇒ (real * real * real) option" where "convert_poly var p xs = ( if MPoly_Type.degree p var < 3 then let (A,B,C) = get_coeffs var p in Some(insertion (nth_default 0 (xs)) A,insertion (nth_default 0 (xs)) B,insertion (nth_default 0 (xs)) C) else None)" fun convert_atom :: "nat ⇒ atom ⇒ real list ⇒ atomUni option" where "convert_atom var (Less p) xs = map_option LessUni (convert_poly var p xs)"| "convert_atom var (Eq p) xs = map_option EqUni (convert_poly var p xs)"| "convert_atom var (Leq p) xs = map_option LeqUni (convert_poly var p xs)"| "convert_atom var (Neq p) xs = map_option NeqUni (convert_poly var p xs)" lemma convert_atom_change : assumes "length xs' = var" shows "convert_atom var At (xs' @ x # Γ) = convert_atom var At (xs' @ x' # Γ)" apply(cases At)using assms apply simp_all by (metis insertion_lowerPoly1 not_in_isovarspar)+ lemma degree_convert_eq : assumes "convert_poly var p xs = Some(a)" shows "MPoly_Type.degree p var < 3" using assms apply(cases "MPoly_Type.degree p var < 3") by auto lemma poly_to_univar : assumes "MPoly_Type.degree p var < 3" assumes "get_coeffs var p = (A,B,C)" assumes "a = insertion (nth_default 0 (xs'@y#xs)) A" assumes "b = insertion (nth_default 0 (xs'@y#xs)) B" assumes "c = insertion (nth_default 0 (xs'@y#xs)) C" assumes "length xs' = var" shows "insertion (nth_default 0 (xs'@x#xs)) p = (a*x^2)+(b*x)+c" proof- have ha: "⋀x. a = insertion (nth_default 0 (xs'@x # xs)) A" using assms(2) apply auto by (metis assms(3) assms(6) insertion_lowerPoly1 not_in_isovarspar) have hb: "⋀x. b = insertion (nth_default 0 (xs'@x # xs)) B" using assms(2) apply auto by (metis assms(4) assms(6) insertion_lowerPoly1 not_in_isovarspar) have hc: "⋀x. c = insertion (nth_default 0 (xs'@x # xs)) C" using assms(2) apply auto by (metis assms(5) assms(6) insertion_lowerPoly1 not_in_isovarspar) show ?thesis proof(cases "MPoly_Type.degree p var = 0") case True have h1 : "var < length (xs'@x#xs)" using assms by auto show ?thesis using assms ha hb hc sum_over_degree_insertion[OF h1 True, of y] apply(simp add: isovar_greater_degree[of p ] True) using True degree0isovarspar by force next case False then have notzero : "MPoly_Type.degree p var ≠ 0" by auto show ?thesis proof(cases "MPoly_Type.degree p var = 1" ) case True have h1 : "var < length (xs'@x#xs)" using assms by auto show ?thesis using sum_over_degree_insertion[OF h1 True, of x, symmetric] unfolding assms(6)[symmetric] list_update_length unfolding assms(6) apply simp using ha hb hc assms apply auto by (smt (verit, ccfv_threshold) One_nat_def True express_poly h1 insertion_add insertion_mult insertion_pow insertion_var list_update_length) next case False then have deg2 : "MPoly_Type.degree p var = 2" using notzero assms by auto have h1 : "var < length (xs'@x#xs)" using assms by auto have two : "2 = Suc(Suc 0)" by auto show ?thesis using sum_over_degree_insertion[OF h1 deg2, of x, symmetric] unfolding assms(6)[symmetric] list_update_length unfolding assms(6) two apply simp using ha hb hc assms apply auto using deg2 express_poly h1 insertion_add insertion_mult insertion_pow insertion_var list_update_length by (smt (verit, best) numeral_2_eq_2) qed qed qed lemma "aEval_aEvalUni": assumes "convert_atom var a (xs'@x#xs) = Some a'" assumes "length xs' = var" shows "aEval a (xs'@x#xs) = aEvalUni a' x" proof(cases a) case (Less x) then show ?thesis proof(cases "MPoly_Type.degree x var < 3") case True then show ?thesis using assms apply(simp add:Less) using poly_to_univar[OF True] by (metis One_nat_def aEvalUni.simps(2) get_coeffs.elims) next case False then show ?thesis using assms Less by auto qed next case (Eq x) then show ?thesis proof(cases "MPoly_Type.degree x var < 3") case True then show ?thesis using assms apply(simp add:Eq) using poly_to_univar[OF True] by (metis One_nat_def aEvalUni.simps(1) get_coeffs.elims) next case False then show ?thesis using assms Eq by auto qed next case (Leq x) then show ?thesis proof(cases "MPoly_Type.degree x var < 3") case True then show ?thesis using assms apply(simp add:Leq) using poly_to_univar[OF True] by (metis One_nat_def aEvalUni.simps(3) get_coeffs.elims) next case False then show ?thesis using assms Leq by auto qed next case (Neq x) then show ?thesis proof(cases "MPoly_Type.degree x var < 3") case True then show ?thesis using assms apply(simp add:Neq) using poly_to_univar[OF True] by (metis One_nat_def aEvalUni.simps(4) get_coeffs.elims) next case False then show ?thesis using assms Neq by auto qed qed fun convert_fm :: "nat ⇒ atom fm ⇒ real list ⇒ (atomUni fmUni) option" where "convert_fm var (Atom a) Γ = map_option (AtomUni) (convert_atom var a Γ)" | "convert_fm var (TrueF) _ = Some TrueFUni" | "convert_fm var (FalseF) _ = Some FalseFUni" | "convert_fm var (And φ ψ) Γ = (case ((convert_fm var φ Γ),(convert_fm var ψ Γ)) of (Some a, Some b) ⇒ Some (AndUni a b) | _ ⇒ None)" | "convert_fm var (Or φ ψ) Γ = (case ((convert_fm var φ Γ),(convert_fm var ψ Γ)) of (Some a, Some b) ⇒ Some (OrUni a b) | _ ⇒ None)" | "convert_fm var (Neg φ) Γ = None " | "convert_fm var (ExQ φ) Γ = None" | "convert_fm var (AllQ φ) Γ = None"| "convert_fm var (AllN i φ) Γ = None"| "convert_fm var (ExN i φ) Γ = None" lemma "eval_evalUni": assumes "convert_fm var F (xs'@x#xs) = Some F'" assumes "length xs' = var" shows "eval F (xs'@x#xs) = evalUni F' x" using assms proof(induction F arbitrary: F') case TrueF then show ?case by auto next case FalseF then show ?case by auto next case (Atom x) then show ?case using aEval_aEvalUni by auto next case (And F1 F2) then show ?case apply(cases "convert_fm var F1 (xs'@x#xs)") apply simp apply(cases "convert_fm var F2 (xs'@x#xs)") by auto next case (Or F1 F2) then show ?case apply(cases "convert_fm var F1 (xs'@x#xs)") apply simp apply(cases "convert_fm var F2 (xs'@x#xs)") by auto next case (Neg F) then show ?case by auto next case (ExQ F) then show ?case by auto next case (AllQ F) then show ?case by auto next case (ExN x1 φ) then show ?case by auto next case (AllN x1 φ) then show ?case by auto qed fun grab_atoms :: "nat ⇒ atom fm ⇒ atom list option" where "grab_atoms var TrueF = Some([])" | "grab_atoms var FalseF = Some([])" | "grab_atoms var (Atom(Eq p)) = (if MPoly_Type.degree p var < 3 then (if MPoly_Type.degree p var > 0 then Some([Eq p]) else Some([])) else None)"| "grab_atoms var (Atom(Less p)) = (if MPoly_Type.degree p var < 3 then (if MPoly_Type.degree p var > 0 then Some([Less p]) else Some([])) else None)"| "grab_atoms var (Atom(Leq p)) = (if MPoly_Type.degree p var < 3 then (if MPoly_Type.degree p var > 0 then Some([Leq p]) else Some([])) else None)"| "grab_atoms var (Atom(Neq p)) = (if MPoly_Type.degree p var < 3 then (if MPoly_Type.degree p var > 0 then Some([Neq p]) else Some([])) else None)"| "grab_atoms var (And a b) = ( case grab_atoms var a of Some(al) ⇒ ( case grab_atoms var b of Some(bl) ⇒ Some(al@bl) | None ⇒ None ) | None ⇒ None )"| "grab_atoms var (Or a b) = ( case grab_atoms var a of Some(al) ⇒ ( case grab_atoms var b of Some(bl) ⇒ Some(al@bl) | None ⇒ None ) | None ⇒ None )"| "grab_atoms var (Neg _) = None"| "grab_atoms var (ExQ _) = None"| "grab_atoms var (AllQ _) = None"| "grab_atoms var (AllN i _) = None"| "grab_atoms var (ExN i _) = None" lemma nil_grab : "(grab_atoms var F = Some []) ⟹ (freeIn var F)" proof(induction F) case TrueF then show ?case by auto next case FalseF then show ?case by auto next case (Atom x) then show ?case proof(cases x) case (Less p) then show ?thesis using Atom apply(cases "MPoly_Type.degree p var < 3") apply auto apply(cases "MPoly_Type.degree p var > 0") apply auto using degree0isovarspar not_in_isovarspar by blast next case (Eq p) then show ?thesis using Atom apply(cases "MPoly_Type.degree p var < 3") apply auto apply(cases "MPoly_Type.degree p var > 0") apply auto using degree0isovarspar not_in_isovarspar by blast next case (Leq p) then show ?thesis using Atom apply(cases "MPoly_Type.degree p var < 3") apply auto apply(cases "MPoly_Type.degree p var > 0") apply auto using degree0isovarspar not_in_isovarspar by blast next case (Neq p) then show ?thesis using Atom apply(cases "MPoly_Type.degree p var < 3") apply auto apply(cases "MPoly_Type.degree p var > 0") apply auto using degree0isovarspar not_in_isovarspar by blast qed next case (And F1 F2) then show ?case apply(cases "grab_atoms var F1") apply(cases "grab_atoms var F2") apply(auto) apply(cases "grab_atoms var F2") apply(auto) apply(cases "grab_atoms var F2") by(auto) next case (Or F1 F2) then show ?case apply(cases "grab_atoms var F1") apply(cases "grab_atoms var F2") apply(auto) apply(cases "grab_atoms var F2") apply(auto) apply(cases "grab_atoms var F2") by(auto) next case (Neg F) then show ?case by auto next case (ExQ F) then show ?case by auto next case (AllQ F) then show ?case by auto next case (ExN x1 F) then show ?case by auto next case (AllN x1 F) then show ?case by auto qed fun isSome :: "'a option ⇒ bool" where "isSome (Some _) = True" | "isSome None = False" lemma "grab_atoms_convert" : "(isSome (grab_atoms var F)) = (isSome (convert_fm var F xs))" proof(induction F) case TrueF then show ?case by auto next case FalseF then show ?case by auto next case (Atom a) then show ?case apply(cases a) by auto next case (And F1 F2) then show ?case by (smt convert_fm.simps(4) grab_atoms.simps(7) isSome.elims(2) isSome.elims(3) option.distinct(1) option.simps(5) option.split_sel_asm prod.simps(2)) next case (Or F1 F2) then show ?case by (smt convert_fm.simps(5) grab_atoms.simps(8) isSome.elims(2) isSome.elims(3) option.distinct(1) option.simps(5) option.split_sel_asm prod.simps(2)) next case (Neg F) then show ?case by auto next case (ExQ F) then show ?case by auto next case (AllQ F) then show ?case by auto next case (ExN x1 F) then show ?case by auto next case (AllN x1 F) then show ?case by auto qed lemma convert_aNeg : assumes "convert_atom var A (xs'@x#xs) = Some(A')" assumes "length xs' = var" shows "aEval (aNeg A) (xs'@x#xs) = aEvalUni (aNegUni A') x" proof- have "aEval (aNeg A) (xs'@x#xs) = (¬ aEval A (xs'@x#xs))" using aNeg_aEval[of A "(xs'@x#xs)"] by auto also have "... = (¬ aEvalUni A' x)" using assms aEval_aEvalUni by auto also have "... = aEvalUni (aNegUni A') x" by(cases A')(auto) finally show ?thesis . qed lemma convert_neg : assumes "convert_fm var F (xs'@x#xs) = Some(F')" assumes "length xs' = var" shows "eval (Neg F) (xs'@x#xs) = evalUni (negUni F') x" using assms proof(induction F arbitrary:F') case TrueF then show ?case by auto next case FalseF then show ?case by auto next case (Atom p) then show ?case using convert_aNeg[of _ p] by (smt aNeg_aEval convert_fm.simps(1) evalUni.simps(1) eval.simps(1) eval.simps(6) map_option_eq_Some negUni.simps(1)) next case (And F1 F2) then show ?case apply auto apply (metis (no_types, lifting) evalUni.simps(5) negUni.simps(4) option.case_eq_if option.collapse option.distinct(1) option.sel) apply (smt (verit, del_insts) evalUni.simps(5) isSome.elims(1) negUni.simps(4) option.inject option.simps(4) option.simps(5)) by (smt (verit, del_insts) evalUni.simps(5) isSome.elims(1) negUni.simps(4) option.inject option.simps(4) option.simps(5)) next case (Or F1 F2) then show ?case apply auto apply (smt (verit, del_insts) evalUni.simps(4) isSome.elims(1) negUni.simps(5) option.inject option.simps(4) option.simps(5)) apply (smt (verit, del_insts) evalUni.simps(4) isSome.elims(1) negUni.simps(5) option.inject option.simps(4) option.simps(5)) by (smt (verit, del_insts) evalUni.simps(4) isSome.elims(1) negUni.simps(5) option.inject option.simps(4) option.simps(5)) next case (Neg F) then show ?case by auto next case (ExQ F) then show ?case by auto next case (AllQ F) then show ?case by auto next case (ExN x1 F) then show ?case by auto next case (AllN x1 F) then show ?case by auto qed fun list_disj_Uni :: "'a fmUni list ⇒ 'a fmUni" where "list_disj_Uni [] = FalseFUni"| "list_disj_Uni (x#xs) = OrUni x (list_disj_Uni xs)" fun list_conj_Uni :: "'a fmUni list ⇒ 'a fmUni" where "list_conj_Uni [] = TrueFUni"| "list_conj_Uni (x#xs) = AndUni x (list_conj_Uni xs)" lemma eval_list_disj_Uni : "evalUni (list_disj_Uni L) x = (∃l∈set(L). evalUni l x)" by(induction L)(auto) lemma eval_list_conj_Uni : "evalUni (list_conj_Uni A) x = (∀l∈set A. evalUni l x)" apply(induction A)by auto lemma eval_list_conj_Uni_append : "evalUni (list_conj_Uni (A @ B)) x = (evalUni (list_conj_Uni (A)) x ∧ evalUni (list_conj_Uni (B)) x)" apply(induction A)by auto fun map_atomUni :: "('a ⇒ 'a fmUni) ⇒ 'a fmUni ⇒ 'a fmUni" where "map_atomUni f (AtomUni a) = f a" | "map_atomUni f (TrueFUni) = TrueFUni" | "map_atomUni f (FalseFUni) = FalseFUni" | "map_atomUni f (AndUni φ ψ) = (AndUni (map_atomUni f φ) (map_atomUni f ψ))" | "map_atomUni f (OrUni φ ψ) = (OrUni (map_atomUni f φ) (map_atomUni f ψ))" fun map_atom :: "(atom ⇒ atom fm) ⇒ atom fm ⇒ atom fm" where "map_atom f TrueF = TrueF"| "map_atom f FalseF = FalseF"| "map_atom f (Atom a) = f a"| "map_atom f (And φ ψ) = And (map_atom f φ) (map_atom f ψ)"| "map_atom f (Or φ ψ) = Or (map_atom f φ) (map_atom f ψ)"| "map_atom f (Neg φ) = TrueF"| "map_atom f (ExQ φ) = TrueF"| "map_atom f (AllQ φ) = TrueF"| "map_atom f (ExN i φ) = TrueF"| "map_atom f (AllN i φ) = TrueF" fun getPoly :: "atomUni => real * real * real" where "getPoly (EqUni p) = p"| "getPoly (LeqUni p) = p"| "getPoly (NeqUni p) = p"| "getPoly (LessUni p) = p" lemma liftatom_map_atom : assumes "∃F'. convert_fm var F xs = Some F'" shows "liftmap f F 0 = map_atom (f 0) F" using assms apply(induction F) apply(auto) apply fastforce apply (metis (no_types, lifting) isSome.elims(2) isSome.elims(3) option.case_eq_if) apply fastforce by (metis (no_types, lifting) isSome.elims(2) isSome.elims(3) option.case_eq_if) lemma eval_map : "(∃l∈set(map f L). evalUni l x) = (∃l∈set(L). evalUni (f l) x)" by auto lemma eval_map_all : "(∀l∈set(map f L). evalUni l x) = (∀l∈set(L). evalUni (f l) x)" by auto lemma eval_append : "(∃l∈set (A#B).evalUni l x) = (evalUni A x ∨ (∃l∈set (B).evalUni l x))" by auto lemma eval_conj_atom : "evalUni (list_conj_Uni (map AtomUni L)) x = (∀l∈set(L). aEvalUni l x)" unfolding eval_list_conj_Uni by auto end
subsection "Negative Infinity" theory NegInfinity imports "HOL-Analysis.Poly_Roots" VSAlgos begin lemma freeIn_allzero : "freeIn var (allZero p var)" by (simp add: not_in_isovarspar freeIn_list_conj) lemma allzero_eval : assumes lLength : "var < length L" shows"(∃x. ∀y<x. aEval (Eq p) (list_update L var y) ) = (∀x. eval (allZero p var) (list_update L var x))" proof- define n where "n = MPoly_Type.degree p var" define k where "k i x =((insertion (nth_default 0(list_update L var x)) (isolate_variable_sparse p var i)))" for i x {fix x have "(eval (allZero p var) (list_update L var x)) = (∀i∈{0..<(MPoly_Type.degree p var)+1}. aEval (Eq(isolate_variable_sparse p var i)) (list_update L var x))" by (simp add: eval_list_conj atLeast0_lessThan_Suc) also have "... = (∀i∈{0..<(MPoly_Type.degree p var)+1}. (insertion (nth_default 0(list_update L var x)) (isolate_variable_sparse p var i))=0)" by simp also have "... = (∀i≤(MPoly_Type.degree p var). (insertion (nth_default 0(list_update L var x)) (isolate_variable_sparse p var i))=0)" by fastforce also have "... = (∀y. (∑i≤(MPoly_Type.degree p var). ((insertion (nth_default 0(list_update L var x)) (isolate_variable_sparse p var i)) * y ^ i))=0)" using polyfun_eq_const[where n="MPoly_Type.degree p var", where k="0", where c="λi. (insertion (nth_default 0(list_update L var x)) (isolate_variable_sparse p var i))"] by (metis (no_types, lifting) le_add2 le_add_same_cancel2) also have "... = (∀y. (∑i≤n. (k i x) * y ^ i)=0)" using k_def n_def by simp finally have "(eval (allZero p var) (list_update L var x)) = (∀y. (∑i≤n. (k i x) * y ^ i)=0)" by simp } then have h1 : "(∀x. (eval (allZero p var) (list_update L var x))) = (∀x.(∀y. (∑i≤n. (k i x) * y ^ i)=0))" by simp have "(∃y. ∀x<y. (∑i≤n. (k i x)* x^i)= 0) = (∃y. ∀x<y. (∑i≤(MPoly_Type.degree p var). (insertion (nth_default 0 (list_update L var x))(isolate_variable_sparse p var i))* x^i)= 0)" using k_def n_def by simp also have "... = (∃y. ∀x<y. insertion (nth_default 0 (list_update L var x)) (∑i≤(MPoly_Type.degree p var). (isolate_variable_sparse p var i)* Var var^i)= 0)" by(simp add: insertion_sum' insertion_mult insertion_pow insertion_var lLength) also have "... = (∃y. ∀x<y. insertion (nth_default 0 (list_update L var x)) p = 0)" using sum_over_zero by simp also have "... = (∃y. ∀x<y. aEval (Eq p) (list_update L var x))" by simp finally have h2 : "(∃y. ∀x<y. aEval (Eq p) (list_update L var x)) = (∃y. ∀x<y. (∑i≤n. (k i x)* x^i)= 0)" by simp have k_all : "∀x y i. k i x = k i y" unfolding k_def by (simp add: insertion_isovarspars_free) have h3a : "(∃y. ∀x<y. (∑i≤n. (k i x)* x^i)= 0) ⟹ (∀x.(∀y. (∑i≤n. (k i x) * y ^ i)=0))" proof- assume h : "(∃y. ∀x<y. (∑i≤n. (k i x)* x^i)= 0)" {fix z y assume h : "(∀x<y. (∑i≤n. (k i x)* x^i)= 0)" have "∀x<y.∀i≤n. k i x = k i z" unfolding k_def using insertion_isovarspars_free by blast then have * : "∀x<y.∀i≤n. k i x * x ^ i = k i z * x^i" by auto then have "∀x<y. (∑i≤n. k i x * x ^ i) = (∑i≤n. k i z * x ^ i)" by (metis (no_types, lifting) k_all sum.cong) then have "∀x<y. (∑i≤n. (k i z)* x^i)= 0" using h by simp then have "¬(finite {x. (∑i≤n. k i z * x ^ i) = 0})" using infinite_Iio[where a="y"] Inf_many_def[where P="λx. (∑i≤n. k i z * x ^ i) = 0"] by (smt INFM_iff_infinite frequently_mono lessThan_def) then have "∀i≤n. k i z = 0" using polyfun_rootbound[where n="n", where c = "λi. k i z" ] by blast } then have "∀x.∀i≤n. k i x = 0" using h by (meson gt_ex) then show ?thesis by simp qed have h3b : "(∀x.(∀y. (∑i≤n. (k i x) * y ^ i)=0)) ⟹ (∃y. ∀x<y. (∑i≤n. (k i x)* x^i)= 0)" proof- assume h : "(∀x.(∀y. (∑i≤n. (k i x) * y ^ i)=0))" {fix z y x have "(∑i≤n. (k i z)* x^i)= 0" using h k_all by blast then have "∀i≤n. k i z = 0" using polyfun_eq_const[where k="0", where c = "λi. k i z", where n="n"] by (metis h) } then have "∀x.∀i≤n. k i x = 0" by (meson gt_ex) then show ?thesis by simp qed have h3 : "(∃y. ∀x<y. (∑i≤n. (k i x)* x^i)= 0) = (∀x.(∀y. (∑i≤n. (k i x) * y ^ i)=0))" using h3a h3b by auto show ?thesis using h1 h2 h3 by simp qed lemma freeIn_altNegInf : "freeIn var (alternateNegInfinity p var)" proof- have h1 : "∀i. var ∉ (vars (if (i::nat) mod 2 = 0 then (Const(1)::real mpoly) else (Const(-1)::real mpoly)))" using var_not_in_Const[where var = "var", where x="1"] var_not_in_Const[where var = "var", where x="-1"] by simp define g where "g = (λF.λi. let a_n = isolate_variable_sparse p var i in let exp = (if i mod 2 = 0 then Const(1) else Const(-1)) in or (Atom(Less (exp * a_n))) (and (Atom (Eq a_n)) F) )" have h3 : "∀i. ∀F. (freeIn var F ⟶ freeIn var (g F i))" using g_def h1 by (smt PolyAtoms.and_def not_in_isovarspar PolyAtoms.or_def freeIn.simps(1) freeIn.simps(2) freeIn.simps(7) freeIn.simps(8) not_in_mult) define L where "L = ([0..<((MPoly_Type.degree p var)+1)])" have "∀F. freeIn var F ⟶ freeIn var (foldl (g::atom fm ⇒ nat ⇒ atom fm) F (L::nat list))" proof(induction L) case Nil then show ?case by simp next case (Cons a L) then show ?case using h3 by simp qed then have "freeIn var (foldl g FalseF L)" using freeIn.simps(6) by blast then show ?thesis using g_def L_def by simp qed theorem freeIn_substNegInfinity : "freeIn var (substNegInfinity var A)" apply(cases A) using freeIn_altNegInf freeIn_allzero by simp_all end
theory NegInfinityUni imports UniAtoms NegInfinity QE begin fun allZero' :: "real * real * real ⇒ atomUni fmUni" where "allZero' (a,b,c) = AndUni(AndUni(AtomUni(EqUni(0,0,a))) (AtomUni(EqUni(0,0,b)))) (AtomUni(EqUni(0,0,c)))" lemma convert_allZero : assumes "convert_poly var p (xs'@x#xs) = Some p'" assumes "length xs' = var" shows "eval (allZero p var) (xs'@x#xs) = evalUni (allZero' p') x" proof(cases p') case (fields a b c) then show ?thesis proof(cases "MPoly_Type.degree p var = 0") case True then show ?thesis using assms fields by(simp add:eval_list_conj isovar_greater_degree) next case False then have nonzero : "MPoly_Type.degree p var ≠ 0" by auto then show ?thesis proof(cases "MPoly_Type.degree p var = 1") case True then show ?thesis using assms fields apply(simp add:eval_list_conj isovar_greater_degree) by (metis) next case False then have degree2 : "MPoly_Type.degree p var = 2" using degree_convert_eq[OF assms(1)] nonzero by auto then show ?thesis using assms apply(simp add:eval_list_conj isovar_greater_degree) using insertion_isovarspars_free list_update_code(2) apply auto by (metis One_nat_def Suc_1 less_2_cases less_Suc_eq numeral_3_eq_3) qed qed qed fun alternateNegInfinity' :: "real * real * real ⇒ atomUni fmUni" where "alternateNegInfinity' (a,b,c) = OrUni(AtomUni(LessUni(0,0,a)))( AndUni(AtomUni(EqUni(0,0,a))) ( OrUni(AtomUni(LessUni(0,0,-b)))( AndUni(AtomUni(EqUni(0,0,b)))( AtomUni(LessUni(0,0,c)) )) )) " lemma convert_alternateNegInfinity : assumes "convert_poly var p (xs'@x#xs) = Some X" assumes "length xs' = var" shows "eval (alternateNegInfinity p var) (xs'@x#xs) = evalUni (alternateNegInfinity' X) x" proof(cases X) case (fields a b c) then show ?thesis proof(cases "MPoly_Type.degree p var = 0") case True then show ?thesis using assms apply (simp add: isovar_greater_degree) apply auto apply (metis aEval.simps(2) eval.simps(1) eval_and eval_false eval_or mult_one_left) by (metis aEval.simps(2) eval.simps(1) eval_or mult_one_left) next case False then have nonzero : "MPoly_Type.degree p var ≠ 0" by auto then show ?thesis proof(cases "MPoly_Type.degree p var = 1") case True have letbind: "eval (let a_n = isolate_variable_sparse p var (Suc 0) in or (fm.Atom (Less (Const (- 1) * a_n))) (and (fm.Atom (Eq a_n)) (let a_n = isolate_variable_sparse p var 0 in or (fm.Atom (Less (Const 1 * a_n))) (and (fm.Atom (Eq a_n)) FalseF)))) (xs'@x#xs) = eval (or (fm.Atom (Less (Const (- 1) * (isolate_variable_sparse p var (Suc 0))))) (and (fm.Atom (Eq (isolate_variable_sparse p var (Suc 0)))) (or (fm.Atom (Less (Const 1 * (isolate_variable_sparse p var 0)))) (and (fm.Atom (Eq (isolate_variable_sparse p var 0))) FalseF)))) (xs'@x#xs)" by meson show ?thesis using assms True unfolding fields by (simp add: isovar_greater_degree letbind eval_or eval_and insertion_mult insertion_const) next case False then have degree2 : "MPoly_Type.degree p var = 2" using degree_convert_eq[OF assms(1)] nonzero by auto have "[0..<3] = [0,1,2]" by (simp add: upt_rec) then have unfold : " (foldl (λF i. let a_n = isolate_variable_sparse p var i in or (fm.Atom (Less ((if i mod 2 = 0 then Const 1 else Const (- 1)) * a_n))) (and (fm.Atom (Eq a_n)) F)) FalseF [0..<3]) = (let a_n = isolate_variable_sparse p var 2 in or (fm.Atom (Less ((Const 1) * a_n))) (and (fm.Atom (Eq a_n)) (let a_n = isolate_variable_sparse p var (Suc 0) in or (fm.Atom (Less (Const (- 1) * a_n))) (and (fm.Atom (Eq a_n)) (let a_n = isolate_variable_sparse p var 0 in or (fm.Atom (Less (Const 1 * a_n))) (and (fm.Atom (Eq a_n)) FalseF))))))" by auto have letbind : "eval (foldl (λF i. let a_n = isolate_variable_sparse p var i in or (fm.Atom (Less ((if i mod 2 = 0 then Const 1 else Const (- 1)) * a_n))) (and (fm.Atom (Eq a_n)) F)) FalseF [0..<3]) (xs'@x#xs) = eval (or (fm.Atom (Less ( Const 1 * (isolate_variable_sparse p var 2)))) (and (fm.Atom (Eq (isolate_variable_sparse p var 2))) (or (fm.Atom (Less (Const (- 1) * (isolate_variable_sparse p var (Suc 0))))) (and (fm.Atom (Eq (isolate_variable_sparse p var (Suc 0)))) (or (fm.Atom (Less (Const 1 * (isolate_variable_sparse p var 0)))) (and (fm.Atom (Eq (isolate_variable_sparse p var 0))) FalseF)))))) (xs'@x#xs)" apply (simp add:unfold) by metis show ?thesis using degree2 assms unfolding fields by (simp add: isovar_greater_degree eval_or eval_and letbind insertion_mult insertion_const) qed qed qed fun substNegInfinityUni :: "atomUni ⇒ atomUni fmUni" where "substNegInfinityUni (EqUni p) = allZero' p " | "substNegInfinityUni (LessUni p) = alternateNegInfinity' p"| "substNegInfinityUni (LeqUni p) = OrUni (alternateNegInfinity' p) (allZero' p)"| "substNegInfinityUni (NeqUni p) = negUni (allZero' p)" lemma convert_substNegInfinity : assumes "convert_atom var A (xs'@x#xs) = Some(A')" assumes "length xs' = var" shows "eval (substNegInfinity var A) (xs'@x#xs) = evalUni (substNegInfinityUni A') x" using assms proof(cases A) case (Less p) have "∃X. convert_poly var p (xs' @ x # xs) = Some X" using assms Less apply(cases "MPoly_Type.degree p var < 3") by (simp_all) then obtain X where X_def: "convert_poly var p (xs' @ x # xs) = Some X" by auto then have A' : "A' = LessUni X" using assms Less apply(cases "MPoly_Type.degree p var < 3") by (simp_all) show ?thesis unfolding Less substNegInfinity.simps unfolding convert_alternateNegInfinity[OF X_def assms(2)] A' apply(cases X) by simp next case (Eq p) then show ?thesis using assms convert_allZero by auto next case (Leq p) define p' where "p' = (case convert_poly var p (xs'@x#xs) of Some p' ⇒ p')" have A'_simp : "A' = LeqUni p'" using assms Leq using p'_def by auto have allZ : "eval (allZero p var) (xs'@x#xs) = evalUni (allZero' p') x" using convert_allZero using Leq assms p'_def by auto have altNeg : "eval (alternateNegInfinity p var) (xs'@x#xs) = evalUni (alternateNegInfinity' p') x" using convert_alternateNegInfinity using Leq assms p'_def by auto show ?thesis unfolding Leq substNegInfinity.simps eval_Or A'_simp substNegInfinityUni.simps evalUni.simps using allZ altNeg by auto next case (Neq p) then show ?thesis using assms convert_allZero convert_neg by auto qed lemma change_eval_eq: fixes x y:: "real" assumes "((aEvalUni (EqUni(a,b,c)) x ≠ aEvalUni (EqUni(a,b,c)) y) ∧ x < y)" shows "(∃w. x ≤ w ∧ w ≤ y ∧ a*w^2 + b*w + c = 0)" using assms by auto lemma change_eval_lt: fixes x y:: "real" assumes "((aEvalUni (LessUni (a,b,c)) x ≠ aEvalUni (LessUni (a,b,c)) y) ∧ x < y)" shows "(∃w. x ≤ w ∧ w ≤ y ∧ a*w^2 + b*w + c = 0)" proof - let ?p = "[:c, b, a:]" have "sign ?p x ≠ sign ?p y" using assms unfolding sign_def apply (simp add: distrib_left mult.commute mult.left_commute power2_eq_square) by linarith then have "(∃w ∈ (root_list ?p). x ≤ w ∧ w ≤ y)" using changes_sign assms by auto then obtain w where w_prop: "w ∈ (root_list ?p) ∧ x ≤ w ∧ w ≤ y" by auto then have "a*w^2 + b*w + c = 0" unfolding root_list_def using add.commute distrib_right mult.assoc mult.commute power2_eq_square using quadratic_poly_eval by force then show ?thesis using w_prop by auto qed lemma no_change_eval_lt: fixes x y:: "real" assumes "x < y" assumes "¬(∃w. x ≤ w ∧ w ≤ y ∧ a*w^2 + b*w + c = 0)" shows "((aEvalUni (LessUni (a,b,c)) x = aEvalUni (LessUni (a,b,c)) y))" using change_eval_lt using assms(1) assms(2) by blast lemma change_eval_neq: fixes x y:: "real" assumes "((aEvalUni (NeqUni (a,b,c)) x ≠ aEvalUni (NeqUni (a,b,c)) y) ∧ x < y)" shows "(∃w. x ≤ w ∧ w ≤ y ∧ a*w^2 + b*w + c = 0)" using assms by auto lemma change_eval_leq: fixes x y:: "real" assumes "((aEvalUni (LeqUni (a,b,c)) x ≠ aEvalUni (LeqUni (a,b,c)) y) ∧ x < y)" shows "(∃w. x ≤ w ∧ w ≤ y ∧ a*w^2 + b*w + c = 0)" proof - let ?p = "[:c, b, a:]" have "sign ?p x ≠ sign ?p y" using assms unfolding sign_def apply (simp add: distrib_left mult.commute mult.left_commute power2_eq_square) by linarith then have "(∃w ∈ (root_list ?p). x ≤ w ∧ w ≤ y)" using changes_sign assms by auto then obtain w where w_prop: "w ∈ (root_list ?p) ∧ x ≤ w ∧ w ≤ y" by auto then have "a*w^2 + b*w + c = 0" unfolding root_list_def using add.commute distrib_right mult.assoc mult.commute power2_eq_square using quadratic_poly_eval by force then show ?thesis using w_prop by auto qed lemma change_eval: fixes x y:: "real" fixes At:: "atomUni" assumes xlt: "x < y" assumes noteq: "((aEvalUni At) x ≠ aEvalUni (At) y)" assumes "getPoly At = (a, b, c)" shows "(∃w. x ≤ w ∧ w ≤ y ∧ a*w^2 + b*w + c = 0)" proof - have four_types: "At = (EqUni (a,b,c)) ∨ At = (LessUni (a,b,c)) ∨ At = (LeqUni (a,b,c)) ∨ At = (NeqUni (a,b,c))" using getPoly.elims assms(3) by force have eq_h: "At = (EqUni (a,b,c)) ⟶ (∃w. x ≤ w ∧ w ≤ y ∧ a*w^2 + b*w + c = 0)" using assms(1) assms(2) change_eval_eq by blast have less_h: "At = (LessUni(a,b,c)) ⟶ (∃w. x ≤ w ∧ w ≤ y ∧ a*w^2 + b*w + c = 0)" using change_eval_lt assms by blast have leq_h: "At = (LeqUni(a,b,c)) ⟶ (∃w. x ≤ w ∧ w ≤ y ∧ a*w^2 + b*w + c = 0)" using change_eval_leq assms by blast have neq_h: "At = (NeqUni(a,b,c)) ⟶ (∃w. x ≤ w ∧ w ≤ y ∧ a*w^2 + b*w + c = 0)" using change_eval_neq assms by blast show ?thesis using four_types eq_h less_h leq_h neq_h by blast qed lemma no_change_eval: fixes x y:: "real" assumes "getPoly At = (a, b, c)" assumes "x < y" assumes "¬(∃w. x ≤ w ∧ w ≤ y ∧ a*w^2 + b*w + c = 0)" shows "((aEvalUni At) x = aEvalUni (At) y ∧ x < y)" using change_eval using assms(1) assms(2) assms(3) by blast lemma same_eval'' : assumes "getPoly At = (a, b, c)" assumes nonz: "a ≠ 0 ∨ b ≠ 0 ∨ c ≠ 0" shows "∃x. ∀y<x. (aEvalUni At y = aEvalUni At x)" proof - let ?p = "[:c, b, a:]" have poly_eval: "∀y. poly ?p y = a*y^2 + b*y + c" by (simp add: distrib_left power2_eq_square) have "?p ≠ 0" using nonz by auto then have "finite {y. poly ?p y = 0}" using poly_roots_finite by blast then have "finite {y. c + (a * y⇧2 + b * y) = 0} ⟹ ∀y. y * (b + y * a) = a * y⇧2 + b * y ⟹ finite {y. a * y⇧2 + b * y + c = 0}" proof - assume a1: "finite {y. c + (a * y⇧2 + b * y) = 0}" have "∀x0. c + (a * x0⇧2 + b * x0) = a * x0⇧2 + b * x0 + c" by simp then show ?thesis using a1 by presburger qed then have finset: "finite {y. a*y^2 + b*y + c = 0}" using poly_eval by (metis ‹finite {y. poly [:c, b, a:] y = 0}› poly_roots_set_same) then have "∃x. (∀y. a*y^2 + b*y + c = 0 ⟶ x < y)" proof - let ?l = "sorted_list_of_set {y. a*y^2 + b*y + c = 0}" have "∃x. x < ?l ! 0" using infzeros nonz by blast then obtain x where x_prop: "x < ?l! 0" by auto then have "∀ y. List.member ?l y ⟶ x < y" proof clarsimp fix y assume "List.member ?l y" then have "∃n. n < length ?l ∧ ?l ! n = y" by (meson in_set_conv_nth in_set_member) then obtain n where n_prop: "n < length ?l ∧ ?l ! n = y" by auto have h: "∀n < length ?l. ?l ! n ≥ ?l !0" using sorted_iff_nth_mono using sorted_sorted_list_of_set by blast then have h: "y ≥ ?l ! 0" using n_prop by auto then show "x < y" using x_prop by auto qed then show ?thesis using finset set_sorted_list_of_set in_set_member by (metis (mono_tags, lifting) mem_Collect_eq) qed then obtain x where x_prop: "(∀y. a*y^2 + b*y + c = 0 ⟶ x < y)" by auto then have same_as: "∀y<x. (aEvalUni At y = aEvalUni At x)" using no_change_eval change_eval assms proof - have f1: "∀x0. (x0 < x) = (¬ 0 ≤ x0 + - 1 * x)" by auto have f2: "(0 ≤ - 1 * x + v0_0) = (x + - 1 * v0_0 ≤ 0)" by auto have f3: "v0_0 + - 1 * x = - 1 * x + v0_0" by auto have f4: "∀x0 x1 x2 x3. (x3::real) * x0⇧2 + x2 * x0 + x1 = x1 + x3 * x0⇧2 + x2 * x0" by auto have f5: "∀x3 x4 x5. (aEvalUni x3 x5 ≠ aEvalUni x3 x4) = ((¬ aEvalUni x3 x5) = aEvalUni x3 x4)" by fastforce have f6: "∀x0 x1 x2 x3 x4 x5. (x5 < x4 ∧ (¬ aEvalUni x3 x5) = aEvalUni x3 x4 ∧ getPoly x3 = (x2, x1, x0) ⟶ (∃v6≥x5. v6 ≤ x4 ∧ x0 + x2 * v6⇧2 + x1 * v6 = 0)) = ((¬ x5 < x4 ∨ (¬ aEvalUni x3 x5) ≠ aEvalUni x3 x4 ∨ getPoly x3 ≠ (x2, x1, x0)) ∨ (∃v6≥x5. v6 ≤ x4 ∧ x0 + x2 * v6⇧2 + x1 * v6 = 0))" by fastforce have f7: "∀x0 x5. ((x0::real) ≤ x5) = (x0 + - 1 * x5 ≤ 0)" by auto have f8: "∀x0 x6. ((x6::real) ≤ x0) = (0 ≤ x0 + - 1 * x6)" by auto have "∀x4 x5. ((x5::real) < x4) = (¬ x4 + - 1 * x5 ≤ 0)" by auto then have "(∀r ra a rb rc rd. r < ra ∧ aEvalUni a r ≠ aEvalUni a ra ∧ getPoly a = (rb, rc, rd) ⟶ (∃re≥r. re ≤ ra ∧ rb * re⇧2 + rc * re + rd = 0)) = (∀r ra a rb rc rd. (ra + - 1 * r ≤ 0 ∨ (¬ aEvalUni a r) ≠ aEvalUni a ra ∨ getPoly a ≠ (rb, rc, rd)) ∨ (∃re. 0 ≤ re + - 1 * r ∧ re + - 1 * ra ≤ 0 ∧ rd + rb * re⇧2 + rc * re = 0))" using f8 f7 f6 f5 f4 by presburger then have f9: "∀r ra a rb rc rd. (ra + - 1 * r ≤ 0 ∨ (¬ aEvalUni a r) ≠ aEvalUni a ra ∨ getPoly a ≠ (rb, rc, rd)) ∨ (∃re. 0 ≤ re + - 1 * r ∧ re + - 1 * ra ≤ 0 ∧ rd + rb * re⇧2 + rc * re = 0)" by (meson change_eval) obtain rr :: "real ⇒ real ⇒ real ⇒ real ⇒ real ⇒ real" where "∀x0 x1 x2 x4 x5. (∃v6. 0 ≤ v6 + - 1 * x5 ∧ v6 + - 1 * x4 ≤ 0 ∧ x0 + x2 * v6⇧2 + x1 * v6 = 0) = (0 ≤ rr x0 x1 x2 x4 x5 + - 1 * x5 ∧ rr x0 x1 x2 x4 x5 + - 1 * x4 ≤ 0 ∧ x0 + x2 * (rr x0 x1 x2 x4 x5)⇧2 + x1 * rr x0 x1 x2 x4 x5 = 0)" by moura then have f10: "∀r ra a rb rc rd. ra + - 1 * r ≤ 0 ∨ aEvalUni a r = aEvalUni a ra ∨ getPoly a ≠ (rb, rc, rd) ∨ r + - 1 * rr rd rc rb ra r ≤ 0 ∧ 0 ≤ ra + - 1 * rr rd rc rb ra r ∧ rd + rb * (rr rd rc rb ra r)⇧2 + rc * rr rd rc rb ra r = 0" using f9 by simp have f11: "(rr c b a x v0_0 + - 1 * x ≤ 0) = (0 ≤ x + - 1 * rr c b a x v0_0)" by force have "∀x0. (x < x0) = (¬ x0 + - 1 * x ≤ 0)" by auto then have f12: "∀r. c + a * r⇧2 + b * r ≠ 0 ∨ ¬ r + - 1 * x ≤ 0" using x_prop by auto obtain rra :: real where "(∃v0. ¬ 0 ≤ v0 + - 1 * x ∧ aEvalUni At v0 ≠ aEvalUni At x) = (¬ 0 ≤ rra + - 1 * x ∧ aEvalUni At rra ≠ aEvalUni At x)" by moura then show ?thesis using f12 f11 f10 f3 f2 f1 proof - have f1: "∀x0. (x0 < x) = (¬ 0 ≤ x0 + - 1 * x)" by auto have f2: "(0 ≤ v0_0a + - 1 * x) = (x + - 1 * v0_0a ≤ 0)" by auto have f3: "(rr c b a x v0_0a + - 1 * x ≤ 0) = (0 ≤ x + - 1 * rr c b a x v0_0a)" by auto obtain rrb :: real where "(∃v0. ¬ 0 ≤ v0 + - 1 * x ∧ aEvalUni At v0 ≠ aEvalUni At x) = (¬ 0 ≤ rrb + - 1 * x ∧ aEvalUni At rrb ≠ aEvalUni At x)" by blast then show ?thesis using f3 f2 f1 assms(1) f10 f12 by smt qed qed then show ?thesis by auto qed lemma inequality_case : "(∃(x::real). ∀(y::real)<x. (a::real) * y⇧2 + (b::real) * y + (c::real) < 0) = (a < 0 ∨ a = 0 ∧ (0 < b ∨ b = 0 ∧ c < 0))" proof- let ?At = "(LessUni (a, b, c))" have firsth : "⋀x. (∀y<x. a * y⇧2 + b * y + c < 0 ⟹ a≤0)" proof - fix x assume lt: "∀y<x. a * y⇧2 + b * y + c < 0" have "∃w. ∀y < w. y^2 > (-b/a)*y - c/a" using ysq_dom_y_plus_coeff[where b = "-b/a", where c = "-c/a"] by auto then have gtdomhelp: "a > 0 ⟹ ∃w. ∀y < w. a*y^2 > a*((-b/a)*y - c/a)" by auto have "∀y. (a > 0 ⟶ a*((-b/a)*y - c/a) = -b*y - c)" by (simp add: right_diff_distrib') then have gtdom: "a > 0 ⟹ ∃w.∀y < w. a*y^2 > -b*y - c" using gtdomhelp by simp then have " a > 0 ⟹ False" proof - assume "a > 0" then have "∃w.∀y < w. a*y^2 > -b*y - c" using gtdom by auto then obtain w where w_prop: "∀y < w. a*y^2 + b*y + c > 0" by fastforce let ?mn = "min w x - 1" have gtz: "a*?mn^2 + b*?mn + c > 0" using w_prop by auto have ltz: "a*?mn^2 + b*?mn + c < 0" using lt by auto then show "False" using gtz ltz by auto qed then show "a ≤ 0" by fastforce qed have bleq0 : "⋀x. (∀y<x. b * y + c < 0 ⟹ b≥0)" proof - fix x assume lt: "∀y<x. b * y + c < 0" have gtdom: "b < 0 ⟹ ∃w.∀y < w. b*y > - c" by (metis mult.commute neg_less_divide_eq) then have "b < 0 ⟹ False" proof - assume "b < 0" then have "∃w.∀y < w. b*y > - c" using gtdom by auto then obtain w where w_prop: "∀y < w .b*y + c > 0" by fastforce let ?mn = "min w x - 1" have gtz: "b*?mn + c > 0" using w_prop by auto have ltz: "b*?mn + c < 0" using lt by auto then show "False" using gtz ltz by auto qed then show "b ≥ 0" by fastforce qed have secondh: "⋀x. (∀y<x. a * y⇧2 + b * y + c < 0 ⟹ ¬ a < 0 ⟹ ¬ 0 < b ⟹ b = 0)" using firsth bleq0 by (metis add.commute add.right_neutral less_eq_real_def mult_zero_class.mult_zero_left) have thirdh : "⋀x. ∀y<x. a * y⇧2 + b * y + c < 0 ⟹ ¬ a < 0 ⟹ ¬ 0 < b ⟹ c < 0" using firsth secondh add.commute add.right_neutral infzeros mult_zero_class.mult_zero_left not_numeral_le_zero order_refl by (metis less_eq_real_def) have fourthh : "a < 0 ⟹ ∃x. ∀y<x. a * y⇧2 + b * y + c < 0" proof - assume aleq: "a < 0" have "∃(w::real). ∀(y::real). (y < w ⟶ y^2 > (-b/a)*y + (-c/a))" using ysq_dom_y_plus_coeff[where b = "-b/a", where c = "-c/a"] by blast then have hyp:"∃(w::real). ∀(y::real). (y < w ⟶ a*y^2 ≤ a*(-b/a)*y + a*(-c/a))" by (metis (no_types, hide_lams) ‹a < 0› distrib_left less_eq_real_def linorder_not_le mult.assoc mult_less_cancel_left) have "∀y. a*(-b/a)*y + a*(-c/a) = -b*y -c" using ‹a < 0› by auto then have "∃(w::real). ∀(y::real). (y < w ⟶ a*y^2 ≤ -b*y - c)" using hyp by auto then have "∃(w::real). ∀(y::real). (y < w ⟶ a*y^2 + b*y + c ≤ 0)" by (metis add.commute add_uminus_conv_diff le_diff_eq mult_minus_left real_add_le_0_iff) then obtain w where w_prop: "∀(y::real). (y < w ⟶ a*y^2 + b*y + c ≤ 0)" by auto have "∃x. ∀y < x. aEvalUni ?At x = aEvalUni ?At y" using same_eval'' proof - have f1: "∀x0 x1. ((x0::real) < x1) = (¬ 0 ≤ x0 + - 1 * x1)" by linarith have "a ≠ 0" using ‹a < 0› by force then obtain rr :: "atomUni ⇒ real" where "∀r. 0 ≤ r + - 1 * rr (LessUni (a, b, c)) ∨ aEvalUni (LessUni (a, b, c)) r = aEvalUni (LessUni (a, b, c)) (rr (LessUni (a, b, c)))" using f1 by (metis getPoly.simps(4) same_eval'') then show ?thesis using f1 by meson qed then obtain x where x_prop: "∀y < x. aEvalUni ?At x = aEvalUni ?At y" by auto let ?mn = "min x w - 1" have "∀y < ?mn. aEvalUni ?At y = True ∨ aEvalUni ?At y = False" using x_prop by auto have "∀ y < ?mn. aEvalUni ?At y = False ⟶ a*y^2 + b*y + c ≥ 0" by auto then have "⋀y. ∀y<w. a * y⇧2 + b * y + c ≤ 0 ⟹ y < min x w - 1 ⟹ ¬ a * y⇧2 + b * y + c < 0 ⟹ a * y⇧2 + b * y + c = 0" proof - fix y :: real assume a1: "y < min x w - 1" assume a2: "¬ a * y⇧2 + b * y + c < 0" assume a3: "∀y<w. a * y⇧2 + b * y + c ≤ 0" have "y < w" using a1 by linarith then show "a * y⇧2 + b * y + c = 0" using a3 a2 less_eq_real_def by blast qed then have "∀ y < ?mn. aEvalUni ?At y = False ⟶ a*y^2 + b*y + c = 0" using w_prop by auto then have "∀ y < ?mn. aEvalUni ?At y = False ⟹ False" using infzeros aleq by (metis power_zero_numeral zero_less_power2) then have "∀ y < ?mn. aEvalUni ?At y = True" proof - { fix rr :: real have "∀r ra. (ra::real) < r ∨ ¬ ra < r + - 1" by linarith then have "¬ rr < min x w - 1 ∨ aEvalUni (LessUni (a, b, c)) rr" by (metis (no_types) ‹∀y<min x w - 1. aEvalUni (LessUni (a, b, c)) y = False ⟹ False› ab_group_add_class.ab_diff_conv_add_uminus less_eq_real_def min_less_iff_disj not_le x_prop) } then show ?thesis by blast qed then show ?thesis by auto qed have fifthh : "b > 0 ⟹ ∃x. ∀y<x. b * y + c < 0" proof- assume bh : "b > 0" show "∃x. ∀y<x. b * y + c < 0" apply(rule exI[where x="-c/b"]) apply auto using bh by (simp add: mult.commute pos_less_minus_divide_eq) qed show ?thesis apply(auto) using firsth apply simp using secondh apply simp using thirdh apply simp using fourthh apply simp using fifthh by simp qed lemma inequality_case_geq : "(∃(x::real). ∀(y::real)<x. (a::real) * y⇧2 + (b::real) * y + (c::real) > 0) = (a > 0 ∨ a = 0 ∧ (0 > b ∨ b = 0 ∧ c > 0))" proof - have s1: "∀y. - 1 * a * y⇧2 + - 1 * b * y + - 1 * c < 0 ⟷ a * y⇧2 + b * y + c > 0" by auto have s2: "(- 1 * a < 0 ∨ - 1 * a = 0 ∧ (0 < - 1 * b ∨ - 1 * b = 0 ∧ - 1 * c < 0)) ⟷ (a > 0 ∨ a = 0 ∧ (0 > b ∨ b = 0 ∧ c > 0)) " by auto have "(∃x. ∀y<x. - 1 * a * y⇧2 + - 1 * b * y + - 1 * c < 0) = (- 1 * a < 0 ∨ - 1 * a = 0 ∧ (0 < - 1 * b ∨ - 1 * b = 0 ∧ - 1 * c < 0))" using inequality_case[where a = "-1*a", where b = "-1*b", where c= "-1*c"] by auto then show ?thesis using s1 s2 by auto qed lemma infinity_evalUni_LessUni : "(∃x. ∀y<x. aEvalUni (LessUni p) y) = (evalUni (substNegInfinityUni (LessUni p)) x)" proof(cases p) case (fields a b c) show ?thesis unfolding fields apply simp using inequality_case[of a b c] . qed lemma infinity_evalUni_EqUni : "(∃x. ∀y<x. aEvalUni (EqUni p) y) = (evalUni (substNegInfinityUni (EqUni p)) x)" proof(cases p) case (fields a b c) show ?thesis using infzeros[of _ a b c] by(auto simp add: fields) qed lemma infinity_evalUni_NeqUni : "(∃x. ∀y<x. aEvalUni (NeqUni p) y) = (evalUni (substNegInfinityUni (NeqUni p)) x)" proof(cases p) case (fields a b c) show ?thesis unfolding fields apply simp using inequality_case[of a b c] using inequality_case_geq[of a b c] by (metis less_numeral_extra(3) linorder_neqE_linordered_idom mult_eq_0_iff) qed lemma infinity_evalUni_LeqUni : "(∃x. ∀y<x. aEvalUni (LeqUni p) y) = (evalUni (substNegInfinityUni (LeqUni p)) x)" proof(cases p) case (fields a b c) show ?thesis unfolding fields apply simp proof - have h1: "((∃x. ∀y<x. a * y⇧2 + b * y + c < 0) ∨ (∃x. ∀y<x. a * y⇧2 + b * y + c = 0)) ⟶ (∃x. ∀y<x. a * y⇧2 + b * y + c ≤ 0)" using less_eq_real_def by auto have h2: "(∃x. ∀y<x. a * y⇧2 + b * y + c ≤ 0) ⟹ ((∃x. ∀y<x. a * y⇧2 + b * y + c < 0) ∨ (∃x. ∀y<x. a * y⇧2 + b * y + c = 0))" proof - assume a1: "(∃x. ∀y<x. a * y⇧2 + b * y + c ≤ 0)" have "¬(∃x. ∀y<x. a * y⇧2 + b * y + c = 0) ⟹ (∃x. ∀y<x. a * y⇧2 + b * y + c < 0) " proof - assume a2: "¬(∃x. ∀y<x. a * y⇧2 + b * y + c = 0)" then have "a ≠ 0 ∨ b ≠ 0 ∨ c ≠ 0" by auto then have "(a < 0 ∨ a = 0 ∧ (0 < b ∨ b = 0 ∧ c < 0))" proof - have x1: "a > 0 ⟹ False" proof - assume "a > 0" then have "(∃(x::real). ∀(y::real)<x. (a::real) * y⇧2 + (b::real) * y + (c::real) > 0)" using inequality_case_geq by auto then show ?thesis using a1 by (meson a2 linorder_not_le min_less_iff_conj) qed then have x2: "a = 0 ∧ 0 > b ⟹ False" proof - assume "a = 0 ∧ 0 > b" then have "(∃(x::real). ∀(y::real)<x. (a::real) * y⇧2 + (b::real) * y + (c::real) > 0)" using inequality_case_geq by blast then show ?thesis using a1 by (meson a2 linorder_not_le min_less_iff_conj) qed then have x3: "a = 0 ∧ b = 0 ∧ c > 0 ⟹ False " using a1 a2 by auto show ?thesis using x1 x2 x3 by (meson ‹a ≠ 0 ∨ b ≠ 0 ∨ c ≠ 0› linorder_neqE_linordered_idom) qed then show "(∃x. ∀y<x. a * y⇧2 + b * y + c < 0)" using inequality_case by auto qed then show ?thesis by auto qed have "(∃x. ∀y<x. a * y⇧2 + b * y + c ≤ 0) = (∃x. ∀y<x. a * y⇧2 + b * y + c < 0) ∨ (∃x. ∀y<x. a * y⇧2 + b * y + c = 0)" using h1 h2 by auto then show "(∃x. ∀y<x. a * y⇧2 + b * y + c ≤ 0) = (a < 0 ∨ a = 0 ∧ (0 < b ∨ b = 0 ∧ c < 0) ∨ a = 0 ∧ b = 0 ∧ c = 0)" using inequality_case[of a b c] infzeros[of _ a b c] by auto qed qed text "This is the vertical translation for substNegInfinityUni where we represent the virtual substution of negative infinity in the univariate case" lemma infinity_evalUni : shows "(∃x. ∀y<x. aEvalUni At y) = (evalUni (substNegInfinityUni At) x)" proof(cases At) case (LessUni p) then show ?thesis using infinity_evalUni_LessUni by auto next case (EqUni p) then show ?thesis using infinity_evalUni_EqUni by auto next case (LeqUni p) then show ?thesis using infinity_evalUni_LeqUni by auto next case (NeqUni p) then show ?thesis using infinity_evalUni_NeqUni by auto qed end
subsection "Infinitesimals" theory Infinitesimals imports ExecutiblePolyProps LinearCase QuadraticCase NegInfinity Debruijn begin lemma freeIn_substInfinitesimalQuadratic : assumes "var ∉ vars a" "var ∉ vars b" "var ∉ vars c" "var ∉ vars d" shows "freeIn var (substInfinitesimalQuadratic var a b c d At)" proof(cases At) case (Less p) show ?thesis unfolding substInfinitesimalQuadratic.simps Less apply(rule free_in_quad_fm[of var a b c d "(convertDerivative var p)"]) using assms by auto next case (Eq p) then show ?thesis apply simp apply(rule freeIn_list_conj) apply auto using not_in_isovarspar by simp_all next case (Leq p) then show ?thesis unfolding substInfinitesimalQuadratic.simps Leq freeIn.simps using free_in_quad_fm[of var a b c d "(convertDerivative var p)", OF assms] apply simp apply(rule freeIn_list_conj) using not_in_isovarspar by simp_all next case (Neq p) then show ?thesis apply (auto simp add:neg_def) apply(rule freeIn_list_conj) apply auto using not_in_isovarspar by simp_all qed lemma freeIn_substInfinitesimalQuadratic_fm : assumes "var ∉ vars a" "var ∉ vars b" "var ∉ vars c" "var ∉ vars d" shows"freeIn var (substInfinitesimalQuadratic_fm var a b c d F)" proof- {fix z have "freeIn (var+z) (liftmap (λx. substInfinitesimalQuadratic (var + x) (liftPoly 0 x a) (liftPoly 0 x b) (liftPoly 0 x c) (liftPoly 0 x d)) F z)" apply(induction F arbitrary:z) apply auto apply(rule freeIn_substInfinitesimalQuadratic) apply (simp_all add: assms not_in_lift) apply (metis (no_types, lifting) add_Suc_right) apply (metis (mono_tags, lifting) add_Suc_right) apply (simp add: ab_semigroup_add_class.add_ac(1)) by (simp add: add.assoc) }then show ?thesis unfolding substInfinitesimalQuadratic_fm.simps by (metis (no_types, lifting) add.right_neutral) qed lemma freeIn_substInfinitesimalLinear: assumes "var ∉ vars a" "var ∉ vars b" shows "freeIn var (substInfinitesimalLinear var a b At)" proof(cases At) case (Less p) show ?thesis unfolding Less substInfinitesimalLinear.simps using var_not_in_linear_fm[of var a b "(convertDerivative var p)", OF assms] unfolding linear_substitution_fm.simps linear_substitution_fm_helper.simps . next case (Eq p) then show ?thesis apply simp apply(rule freeIn_list_conj) apply auto using not_in_isovarspar by simp_all next case (Leq p) show ?thesis unfolding Leq substInfinitesimalLinear.simps freeIn.simps using var_not_in_linear_fm[of var a b "(convertDerivative var p)", OF assms] unfolding linear_substitution_fm.simps linear_substitution_fm_helper.simps apply simp apply(rule freeIn_list_conj) apply auto using not_in_isovarspar by simp_all next case (Neq p) then show ?thesis apply (auto simp add:neg_def) apply(rule freeIn_list_conj) apply auto using not_in_isovarspar by simp_all qed lemma freeIn_substInfinitesimalLinear_fm: assumes "var ∉ vars a" "var ∉ vars b" shows "freeIn var (substInfinitesimalLinear_fm var a b F)" proof- {fix z have "freeIn (var+z) (liftmap (λx. substInfinitesimalLinear (var + x) (liftPoly 0 x a) (liftPoly 0 x b)) F z)" apply(induction F arbitrary:z) apply auto apply(rule freeIn_substInfinitesimalLinear) apply (simp_all add: assms not_in_lift) apply (metis (full_types) Suc_eq_plus1 ab_semigroup_add_class.add_ac(1)) apply (metis (full_types) Suc_eq_plus1 ab_semigroup_add_class.add_ac(1)) apply (simp add: add.assoc) by (simp add: add.assoc) } then show ?thesis unfolding substInfinitesimalLinear_fm.simps by (metis (no_types, lifting) add.right_neutral) qed end
theory InfinitesimalsUni imports Infinitesimals UniAtoms NegInfinityUni QE begin fun convertDerivativeUni :: "real * real * real ⇒ atomUni fmUni" where "convertDerivativeUni (a,b,c) = OrUni(AtomUni(LessUni(a,b,c)))(AndUni(AtomUni(EqUni(a,b,c)))( OrUni(AtomUni(LessUni(0,2*a,b)))(AndUni(AtomUni(EqUni(0,2*a,b)))( (AtomUni(LessUni(0,0,2*a))) )) )) " lemma convert_convertDerivative : assumes "convert_poly var p (xs'@x#xs) = Some(a,b,c)" assumes "length xs' = var" shows "eval (convertDerivative var p) (xs'@x#xs) = evalUni (convertDerivativeUni (a,b,c)) x" proof(cases "MPoly_Type.degree p var = 0") case True then show ?thesis using assms apply (simp add: isovar_greater_degree eval_or eval_and insertion_mult insertion_const) using sum_over_zero[of p var] by auto next case False then have nonzero: "MPoly_Type.degree p var ≠ 0" by auto then show ?thesis proof(cases "MPoly_Type.degree p var = 1") case True have h1 : "MPoly_Type.degree p var < 3" using True by auto have h2 : "get_coeffs var p = (isolate_variable_sparse p var 2, isolate_variable_sparse p var 1, isolate_variable_sparse p var 0)" by auto have h : "insertion (nth_default 0 (xs' @ x # xs)) p = b * x + c" using poly_to_univar[OF h1 h2 _ _ _ assms(2), of a x xs b c x] using assms(1) apply(cases "MPoly_Type.degree p var < 3") apply simp_all using isovar_greater_degree[of p var] unfolding True by simp have h3: "MPoly_Type.degree (isolate_variable_sparse p var (Suc 0) * Const 1) var = 0" using degree_mult[of "isolate_variable_sparse p var (Suc 0)" "Const 1" var] using degree_isovarspar mult_one_right by presburger show ?thesis using assms True unfolding convertDerivative.simps[of _ p] convertDerivative.simps[of _ "(derivative var p)"] apply (simp add: derivative_def isovar_greater_degree eval_or eval_and insertion_add insertion_mult insertion_const HOL.arg_cong[OF sum_over_zero[of p var], of "insertion (nth_default var (xs'@x#xs))"] insertion_var_zero del:convertDerivative.simps) unfolding h h3 by(simp del:convertDerivative.simps) next case False then have deg2 : "MPoly_Type.degree p var = 2" by (metis One_nat_def assms(1) convert_poly.simps le_SucE less_Suc0 less_Suc_eq_le nonzero numeral_2_eq_2 numeral_3_eq_3 option.distinct(1)) then have first : "isolate_variable_sparse p var (Suc (Suc 0)) ≠ 0" by (metis MPoly_Type.degree_zero isolate_variable_sparse_degree_eq_zero_iff nat.distinct(1) numeral_2_eq_2) have second : "(isolate_variable_sparse p var (Suc (Suc 0)) * Var var)≠0" by (metis MPoly_Type.degree_zero One_nat_def ExecutiblePolyProps.degree_one Zero_not_Suc first mult_eq_0_iff) have other : "Const (2::real)≠0" by (simp add: nonzero_const_is_nonzero) have thing: "(Var var::real mpoly) ≠ 0" using second by auto have degree: "MPoly_Type.degree (isolate_variable_sparse p var (Suc 0) * Const 1 + isolate_variable_sparse p var (Suc (Suc 0)) * Var var * Const 2) var - Suc 0 = 0" apply simp apply(rule Nat.eq_imp_le) apply(rule degree_less_sum'[of _ _ 0]) apply (simp add: degree_isovarspar mult_one_right) apply auto unfolding degree_mult[OF second other, of var] degree_const apply simp unfolding degree_mult[OF first thing] degree_one using degree_isovarspar by force have insertion: "insertion (nth_default 0 (xs'@x#xs)) (∑(i::nat)≤2. isolate_variable_sparse p var i * Var var ^ i) = a * x^2 + b * x + c" proof(cases "MPoly_Type.degree p var = 1") case True then show ?thesis using False by blast next case False then have deg2 : "MPoly_Type.degree p var = 2" by (metis One_nat_def assms(1) convert_poly.simps le_SucE less_Suc0 less_Suc_eq_le nonzero numeral_2_eq_2 numeral_3_eq_3 option.distinct(1)) then have degless3 : "MPoly_Type.degree p var < 3" by auto have thing : "var<length(xs'@x # xs)" using assms by auto have h : "(∑i≤2. isolate_variable_sparse p var i * Var var ^ i) = p" using deg2 by (metis sum_over_zero) have three: "(3::nat) = Suc(Suc(Suc(0)))" by auto have "(∑i = 0..<3. insertion (nth_default 0 (xs'@x#xs)) (isolate_variable_sparse p var i) * x ^ i) = (insertion (nth_default 0 (xs'@x#xs)) (isolate_variable_sparse p var 0) * x ^ 0) + (insertion (nth_default 0 (xs'@x#xs)) (isolate_variable_sparse p var (1::nat)) * x ^ (1::nat)) + (insertion (nth_default 0 (xs'@x#xs)) (isolate_variable_sparse p var (2::nat)) * x ^ (2::nat))" unfolding Set_Interval.comm_monoid_add_class.sum.atLeast0_lessThan_Suc three proof - have "insertion (nth_default 0 (xs'@x#xs)) (isolate_variable_sparse p var (MPoly_Type.degree p var)) * x ^ MPoly_Type.degree p var + (x * insertion (nth_default 0 (xs'@x#xs)) (isolate_variable_sparse p var 1) + (insertion (nth_default 0 (xs'@x#xs)) (isolate_variable_sparse p var 0) + (∑n = 0..<0. insertion (nth_default 0 (xs'@x#xs)) (isolate_variable_sparse p var n) * x ^ n))) = insertion (nth_default 0 (xs'@x#xs)) (isolate_variable_sparse p var 0) + x * insertion (nth_default 0 (xs'@x#xs)) (isolate_variable_sparse p var 1) + insertion (nth_default 0 (xs'@x#xs)) (isolate_variable_sparse p var (MPoly_Type.degree p var)) * x ^ MPoly_Type.degree p var" by auto then show "(∑n = 0..<0. insertion (nth_default 0 (xs'@x#xs)) (isolate_variable_sparse p var n) * x ^ n) + insertion (nth_default 0 (xs'@x#xs)) (isolate_variable_sparse p var 0) * x ^ 0 + insertion (nth_default 0 (xs'@x#xs)) (isolate_variable_sparse p var (Suc 0)) * x ^ Suc 0 + insertion (nth_default 0 (xs'@x#xs)) (isolate_variable_sparse p var (Suc (Suc 0))) * x ^ Suc (Suc 0) = insertion (nth_default 0 (xs'@x#xs)) (isolate_variable_sparse p var 0) * x ^ 0 + insertion (nth_default 0 (xs'@x#xs)) (isolate_variable_sparse p var 1) * x ^ 1 + insertion (nth_default 0 (xs'@x#xs)) (isolate_variable_sparse p var 2) * x⇧2" by (metis (no_types) One_nat_def Suc_1 add.commute deg2 mult.commute mult.left_neutral power_0 power_one_right) qed also have "... = a * x⇧2 + b * x + c" unfolding Power.power_class.power.power_0 Power.monoid_mult_class.power_one_right Groups.monoid_mult_class.mult_1_right using assms unfolding convert_poly.simps using degless3 by simp finally have h2 :"(∑i = 0..<3. insertion (nth_default 0 (xs'@x#xs)) (isolate_variable_sparse p var i) * x ^ i) = a * x⇧2 + b * x + c " . show ?thesis using sum_over_degree_insertion[OF thing deg2, of x] apply auto using h h2 using assms(2) by auto qed have insertionb: "insertion (nth_default 0 (xs'@x#xs)) (isolate_variable_sparse p var (Suc 0)) = b" using assms apply(cases "MPoly_Type.degree p var < 3") by simp_all have insertiona : "insertion (nth_default 0 (xs'@x#xs)) (isolate_variable_sparse p var (Suc (Suc 0))) = a" using assms apply(cases "MPoly_Type.degree p var < 3") apply simp_all by (simp add: numeral_2_eq_2) have x : "insertion (nth_default 0 (xs' @ x # xs)) (Var var) = x" using insertion_var[of var "(xs' @ x # xs)" x] using assms(2) by auto have zero1 : "insertion (nth_default 0 (xs' @ x # xs)) (isolate_variable_sparse (isolate_variable_sparse p var (Suc 0)) var (Suc 0)) = 0" by (simp add: degree_isovarspar isovar_greater_degree) have zero2 : "insertion (nth_default 0 (xs' @ x # xs)) (isolate_variable_sparse (isolate_variable_sparse p var (Suc (Suc 0))) var 0) = a" using degree0isovarspar degree_isovarspar insertiona by presburger have zero3 : "insertion (nth_default 0 (xs' @ x # xs)) (isolate_variable_sparse (Var var) var (Suc 0)) = 1" using isolate_var_one using MPoly_Type.insertion_one by fastforce have zero4 : "insertion (nth_default 0 (xs' @ x # xs)) (isolate_variable_sparse (isolate_variable_sparse p var (Suc (Suc 0))) var (Suc 0)) = 0" by (simp add: degree_isovarspar isovar_greater_degree) have insertion_deriv : "insertion (nth_default 0 (xs'@x#xs)) (isolate_variable_sparse (isolate_variable_sparse p var (Suc 0) * Const 1 + isolate_variable_sparse p var (Suc (Suc 0)) * Var var * Const 2) var (Suc 0)) = 2*a" unfolding isovarspar_sum isolate_variable_sparse_mult apply auto unfolding const_lookup_suc const_lookup_zero Rings.mult_zero_class.mult_zero_right Groups.group_add_class.add.group_left_neutral unfolding insertion_add insertion_mult insertion_const apply auto unfolding zero1 zero2 zero3 zero4 by simp have deg2 : "MPoly_Type.degree p var = 2" using degree_convert_eq[OF assms(1)] False nonzero by auto then show ?thesis using assms unfolding convertDerivative.simps[of _ p] convertDerivative.simps[of _ "(derivative var p)"] convertDerivative.simps[of _ "(derivative var (derivative var p))"] apply (simp add: x insertionb insertiona insertion_deriv insertion degree derivative_def isovar_greater_degree eval_or eval_and insertion_add insertion_mult insertion_const HOL.arg_cong[OF sum_over_zero[of p var], of "insertion (nth_default 0 (xs'@x#xs))"] insertion_var_zero del:convertDerivative.simps) by (smt (z3) One_nat_def degree_isovarspar distrib_right insertion_deriv isolate_variable_sparse_ne_zeroD mult_one_right neq0_conv not_one_le_zero zero1) qed qed fun linearSubstitutionUni :: "real ⇒ real ⇒ atomUni ⇒ atomUni fmUni" where "linearSubstitutionUni b c a = (if aEvalUni a (-c/b) then TrueFUni else FalseFUni)" lemma convert_linearSubstitutionUni: assumes "convert_atom var a (xs'@x#xs) = Some(a')" assumes "insertion (nth_default 0 (xs'@x#xs)) b = B" assumes "insertion (nth_default 0 (xs'@x#xs)) c = C" assumes "B ≠ 0" assumes "var∉(vars b)" assumes "var∉(vars c)" assumes "length xs' = var" shows "aEval (linear_substitution var (-c) b a) (xs'@x#xs) = evalUni (linearSubstitutionUni B C a') x" using assms proof - have "aEval a (xs'@(-C/B)#xs) = evalUni (linearSubstitutionUni B C a') x" using assms(1) proof(cases "a") case (Less p) then have "MPoly_Type.degree p var < 3" using assms(1)apply(cases "MPoly_Type.degree p var < 3") by auto then show ?thesis using Less assms apply simp using poly_to_univar by force next case (Eq p) then have "MPoly_Type.degree p var < 3" using assms(1)apply(cases "MPoly_Type.degree p var < 3") by auto then show ?thesis using Eq assms apply simp using poly_to_univar by force next case (Leq p) then have "MPoly_Type.degree p var < 3" using assms(1)apply(cases "MPoly_Type.degree p var < 3") by auto then show ?thesis using Leq assms apply simp using poly_to_univar by force next case (Neq p) then have "MPoly_Type.degree p var < 3" using assms(1)apply(cases "MPoly_Type.degree p var < 3") by auto then show ?thesis using Neq assms apply simp using poly_to_univar by force qed then have subst : "aEval a ((xs'@x#xs)[var := - C / B]) = evalUni (linearSubstitutionUni B C a') x" using assms by auto have hlength : "var< length (xs'@x#xs)" using assms by auto have inB : "insertion (nth_default 0 ((xs'@x#xs)[var := - C / B])) b = B" using assms apply auto apply(cases a) apply auto by (simp add: insertion_lowerPoly1)+ have inC : "insertion (nth_default 0 ((xs'@x#xs)[var := - C / B])) (-c) = -C" using assms apply auto apply(cases a) apply auto by (simp add: insertion_lowerPoly1 insertion_neg)+ have freenegc : "var∉vars(-c)" using assms not_in_neg by auto show ?thesis using linear[OF hlength assms(4) freenegc assms(5) inC inB, of a ] subst using var_not_in_eval3[OF var_not_in_linear[OF freenegc assms(5)] assms(7)] by (metis assms(7) list_update_length) qed (* substInfinitesimalLinear var b c A substitutes -c/b+epsilon for variable var in atom A assumes b is nonzero defined in page 615 *) fun substInfinitesimalLinearUni :: "real ⇒ real ⇒ atomUni ⇒ atomUni fmUni" where "substInfinitesimalLinearUni b c (EqUni p) = allZero' p"| "substInfinitesimalLinearUni b c (LessUni p) = map_atomUni (linearSubstitutionUni b c) (convertDerivativeUni p)"| "substInfinitesimalLinearUni b c (LeqUni p) = OrUni (allZero' p) (map_atomUni (linearSubstitutionUni b c) (convertDerivativeUni p))"| "substInfinitesimalLinearUni b c (NeqUni p) = negUni (allZero' p)" lemma convert_linear_subst_fm : assumes "convert_atom var a (xs'@x#xs) = Some a'" assumes "insertion (nth_default 0 (xs'@x#xs)) b = B" assumes "insertion (nth_default 0 (xs'@x#xs)) c = C" assumes "B ≠ 0" assumes "var∉(vars b)" assumes "var∉(vars c)" assumes "length xs' = var" shows "aEval (linear_substitution (var + 0) (liftPoly 0 0 (-c)) (liftPoly 0 0 b) a) (xs'@x#xs) = evalUni (linearSubstitutionUni B C a') x" proof- have lb : "insertion (nth_default 0 (xs'@x#xs)) (liftPoly 0 0 b) = B" unfolding lift00 using assms(2) by auto have lc : "insertion (nth_default 0 (xs'@x#xs)) (liftPoly 0 0 c) = C" unfolding lift00 using assms(3) insertion_neg by auto have nb : "var ∉ vars (liftPoly 0 0 b)" using not_in_lift[OF assms(5), of 0] by auto have nc : "var ∉ vars (liftPoly 0 0 c)" using not_in_lift[OF assms(6)] not_in_neg using assms(6) lift00 by auto then show ?thesis using assms using lb lc convert_linearSubstitutionUni[OF assms(1) lb lc assms(4) nb nc] by (simp add: lift00) qed lemma evalUni_if : "evalUni (if cond then TrueFUni else FalseFUni) x = cond" by(cases cond)(auto) lemma degree_less_sum' : "MPoly_Type.degree (p::real mpoly) var = n ⟹ MPoly_Type.degree (q::real mpoly) var = m ⟹ n < m ⟹ MPoly_Type.degree (p + q) var = m" using degree_less_sum[of q var m p n] by (simp add: add.commute) lemma convert_substInfinitesimalLinear_less : assumes "convert_poly var p (xs'@x#xs) = Some(p')" assumes "insertion (nth_default 0 (xs'@x#xs)) b = B" assumes "insertion (nth_default 0 (xs'@x#xs)) c = C" assumes "B ≠ 0" assumes "var∉(vars b)" assumes "var∉(vars c)" assumes "length xs' = var" shows " eval (liftmap (λx. λA. Atom(linear_substitution (var+x) (liftPoly 0 x (-c)) (liftPoly 0 x b) A)) (convertDerivative var p) 0) (xs'@x#xs) = evalUni (map_atomUni (linearSubstitutionUni B C) (convertDerivativeUni p')) x" proof(cases p') case (fields a' b' c') have h : "convert_poly var p (xs'@x#xs) = Some (a', b', c')" using assms fields by auto have h2 : "∃F'. convert_fm var (convertDerivative var p) xs = Some F'" unfolding convertDerivative.simps[of _ p] convertDerivative.simps[of _ "derivative var p"] convertDerivative.simps[of _ "derivative var (derivative var p)"] apply( auto simp del: convertDerivative.simps) using degree_convert_eq h apply blast using assms(1) degree_convert_eq apply blast apply (metis Suc_eq_plus1 degree_derivative gr_implies_not0 less_trans_Suc nat_neq_iff) using assms(1) degree_convert_eq apply blast apply (meson assms(1) degree_convert_eq) apply (metis One_nat_def Suc_eq_plus1 degree_derivative less_2_cases less_Suc_eq nat_neq_iff numeral_3_eq_3 one_add_one) using assms(1) degree_convert_eq apply blast using degree_derivative apply force using assms(1) degree_convert_eq apply blast apply (meson assms(1) degree_convert_eq) apply (metis degree_derivative eq_numeral_Suc less_add_one less_trans_Suc not_less_eq numeral_2_eq_2 pred_numeral_simps(3)) apply (meson assms(1) degree_convert_eq) using degree_derivative apply fastforce by (meson assms(1) degree_convert_eq) have c'_insertion : "insertion (nth_default 0 (xs'@x#xs)) (isolate_variable_sparse p var 0) = c'" using assms fields unfolding convert_poly.simps apply(cases "MPoly_Type.degree p var < 3") by auto have b'_insertion : "insertion (nth_default 0 (xs'@x#xs)) (isolate_variable_sparse p var (Suc 0)) = b'" using assms fields unfolding convert_poly.simps apply(cases "MPoly_Type.degree p var < 3") by auto then have b'_insertion2 : "insertion (nth_default 0 (xs'@x#xs)) (isolate_variable_sparse p var 1) = b'" by auto have a'_insertion : "insertion (nth_default 0 (xs'@x#xs)) (isolate_variable_sparse p var 2) = a'" using assms fields unfolding convert_poly.simps apply(cases "MPoly_Type.degree p var < 3") by auto have liftb : "liftPoly 0 0 b = b" using lift00 by auto have liftc : "liftPoly 0 0 c = c" using lift00 by auto have b'_insertion' : "insertion (nth_default 0 (xs'@x#xs)) (isolate_variable_sparse (isolate_variable_sparse p var (Suc 0)) var 0) = b'" using assms fields unfolding convert_poly.simps apply(cases "MPoly_Type.degree p var < 3") apply auto by (simp add: degree0isovarspar degree_isovarspar) have insertion_into_1 : "insertion (nth_default 0 (xs'@x#xs)) (isolate_variable_sparse (Const 1) var 0) = 1" by (simp add: const_lookup_zero insertion_const) have twominusone : "((2-1)::nat) = 1" by auto show ?thesis proof(cases "MPoly_Type.degree p var = 0") case True have simp: "(convertDerivative var p)=Atom(Less p)" using True by auto have azero : "a'=0" by (metis MPoly_Type.insertion_zero True a'_insertion isolate_variable_sparse_ne_zeroD nat.simps(3) not_less numeral_2_eq_2 zero_less_iff_neq_zero) have bzero : "b'=0" using True b'_insertion isovar_greater_degree by fastforce show ?thesis unfolding fields substInfinitesimalLinearUni.simps convertDerivativeUni.simps linearSubstitutionUni.simps map_atomUni.simps evalUni.simps evalUni_if aEvalUni.simps Rings.mult_zero_class.mult_zero_left Rings.mult_zero_class.mult_zero_right Groups.add_0 azero bzero substInfinitesimalLinear.simps convertDerivative.simps[of _ p] True simp liftmap.simps linear_substitution.simps apply (auto simp add:True) unfolding c'_insertion by auto next case False then have degnot0 : "MPoly_Type.degree p var ≠ 0" by auto then show ?thesis proof(cases "MPoly_Type.degree p var = 1") case True then have simp : "convertDerivative var p = Or (fm.Atom (Less p)) (And (fm.Atom (Eq p)) (fm.Atom (Less (derivative var p))))" by (metis One_nat_def Suc_eq_plus1 add_right_imp_eq convertDerivative.simps degnot0 degree_derivative zero_less_one) have azero : "a'=0" by (metis MPoly_Type.insertion_zero One_nat_def True a'_insertion isovar_greater_degree lessI numeral_2_eq_2) have degderiv : "MPoly_Type.degree (isolate_variable_sparse p var (Suc 0) * Const 1) var = 0" using degree_mult by (simp add: degree_isovarspar mult_one_right) show ?thesis unfolding fields substInfinitesimalLinearUni.simps convertDerivativeUni.simps linearSubstitutionUni.simps map_atomUni.simps evalUni.simps evalUni_if aEvalUni.simps Rings.mult_zero_class.mult_zero_left Rings.mult_zero_class.mult_zero_right Groups.add_0 azero substInfinitesimalLinear.simps True simp liftmap.simps linear_substitution.simps eval_Or eval_And liftb liftc apply auto unfolding derivative_def True insertion_sub insertion_mult c'_insertion b'_insertion assms lift00 apply auto unfolding insertion_sub insertion_mult c'_insertion b'_insertion assms lift00 apply (smt diff_divide_eq_iff divide_less_0_iff mult_less_0_iff) apply (smt mult_imp_less_div_pos neg_less_divide_eq zero_le_mult_iff) using assms(4) mult.commute nonzero_mult_div_cancel_left apply smt unfolding degderiv apply auto unfolding isolate_variable_sparse_mult apply auto unfolding insertion_mult defer apply (smt assms(4) diff_divide_eq_iff divide_less_0_iff mult_less_0_iff) defer using assms(4) apply blast unfolding b'_insertion' insertion_into_1 apply auto by (smt assms(4) less_divide_eq mult_pos_neg2 no_zero_divisors zero_less_mult_pos) next case False then have degreetwo : "MPoly_Type.degree p var = 2" using degnot0 by (metis One_nat_def degree_convert_eq h less_2_cases less_Suc_eq numeral_2_eq_2 numeral_3_eq_3) have two : "(2::nat) = Suc(Suc 0)" by auto have sum : "(∑i = 0..<2. isolate_variable_sparse p var i * (- c) ^ i * b ^ (2 - i)) = isolate_variable_sparse p var 0 * (- c) ^ 0 * b ^ (2 - 0) + isolate_variable_sparse p var 1 * (- c) ^ 1 * b ^ (2 - 1) " unfolding Set_Interval.comm_monoid_add_class.sum.atLeast0_lessThan_Suc two by auto have a : "isolate_variable_sparse p var (Suc (Suc 0)) ≠ 0" by (metis degnot0 degree_isovarspar degreetwo isolate_variable_sparse_degree_eq_zero_iff numeral_2_eq_2) have b : "((Var var * Const 2) :: real mpoly) ≠ (0::real mpoly)" by (metis MPoly_Type.degree_zero ExecutiblePolyProps.degree_one mult_eq_0_iff nonzero_const_is_nonzero zero_neq_numeral zero_neq_one) have degreedeg1 : "MPoly_Type.degree (isolate_variable_sparse p var (Suc 0) * Const 1 + isolate_variable_sparse p var (Suc (Suc 0)) * Var var * Const 2) var = 1" apply(rule degree_less_sum'[where n ="0"]) apply (simp add: degree_isovarspar mult_one_right) defer apply simp using degree_mult[OF a b, of var] by (metis (no_types, hide_lams) ExecutiblePolyProps.degree_one add.left_neutral b degree_const degree_isovarspar degree_mult mult.commute mult_zero_class.mult_zero_right) have simp : "(convertDerivative var p) = Or (fm.Atom (Less p)) (And (fm.Atom (Eq p)) (Or (fm.Atom (Less (derivative var p))) (And (fm.Atom (Eq (derivative var p))) (fm.Atom (Less (derivative var (derivative var p)))))))" using degreetwo by (metis One_nat_def Suc_1 Suc_eq_plus1 add_diff_cancel_right' convertDerivative.simps degree_derivative neq0_conv zero_less_Suc) have a : "insertion (nth_default 0 (xs'@x#xs)) (isolate_variable_sparse (isolate_variable_sparse p var (Suc 0) * Const 1 + isolate_variable_sparse p var (Suc (Suc 0)) * Var var * Const 2) var 0) = b'" unfolding isovarspar_sum isolate_variable_sparse_mult apply auto unfolding const_lookup_suc const_lookup_zero Rings.mult_zero_class.mult_zero_right Groups.group_add_class.add.group_left_neutral by (simp add: b'_insertion' isolate_var_0 mult_one_right) have b : "insertion (nth_default 0 (xs'@x#xs)) (isolate_variable_sparse (isolate_variable_sparse p var (Suc 0) * Const 1 + isolate_variable_sparse p var (Suc (Suc 0)) * Var var * Const 2) var (Suc 0)) = 2 * a'" unfolding isovarspar_sum isolate_variable_sparse_mult apply auto unfolding const_lookup_suc const_lookup_zero Rings.mult_zero_class.mult_zero_right Groups.group_add_class.add.group_left_neutral unfolding insertion_add insertion_mult insertion_const by (metis MPoly_Type.insertion_one MPoly_Type.insertion_zero One_nat_def a'_insertion add.commute add.right_neutral degree0isovarspar degree_isovarspar isolate_var_one isovar_greater_degree mult.commute mult.right_neutral mult_zero_class.mult_zero_right numeral_2_eq_2 zero_less_one) have simp_insertion_blob : "insertion (nth_default 0 (xs'@x#xs)) (isolate_variable_sparse (isolate_variable_sparse p var (Suc 0) * Const 1 + isolate_variable_sparse p var (Suc (Suc 0)) * Var var * Const 2) var 0 * b - isolate_variable_sparse (isolate_variable_sparse p var (Suc 0) * Const 1 + isolate_variable_sparse p var (Suc (Suc 0)) * Var var * Const 2) var (Suc 0) * c) = b' * B - 2 * a' * C" unfolding insertion_sub insertion_mult assms a b by auto have a : "isolate_variable_sparse (isolate_variable_sparse p var (Suc 0) * Const 1 + isolate_variable_sparse p var (Suc (Suc 0)) * Var var * Const 2) var (Suc 0) ≠ 0" by (metis MPoly_Type.degree_zero One_nat_def degreedeg1 isolate_variable_sparse_degree_eq_zero_iff zero_neq_one) have b' : "(Const 1::real mpoly) ≠ 0" by (simp add: nonzero_const_is_nonzero) have degreeblob : "MPoly_Type.degree (isolate_variable_sparse (isolate_variable_sparse p var (Suc 0) * Const 1 + isolate_variable_sparse p var (Suc (Suc 0)) * Var var * Const 2) var (Suc 0) * Const 1) var = 0" unfolding degree_mult[OF a b', of var] by (simp add: degree_isovarspar degree_eq_iff monomials_Const) have otherblob : "insertion (nth_default 0 (xs'@x#xs)) (isolate_variable_sparse (isolate_variable_sparse (isolate_variable_sparse p var (Suc 0) * Const 1 + isolate_variable_sparse p var (Suc (Suc 0)) * Var var * Const 2) var (Suc 0) * Const 1) var 0) = 2 * a'" using b by (simp add: degree0isovarspar degree_isovarspar mult_one_right) have "(c' * B⇧2 - b' * C * B + a' * C⇧2 < 0) = ((c' * B⇧2 - b' * C * B + a' * C⇧2)/(B⇧2) < 0)" by (simp add: assms(4) divide_less_0_iff) also have "... = (((c' * B⇧2)/(B⇧2) - (b' * C * B)/(B⇧2) + (a' * C⇧2)/(B⇧2)) < 0)" by (metis (no_types, lifting) add_divide_distrib diff_divide_distrib ) also have "... = (a' * (C / B)⇧2 - b' * C / B + c' < 0)" proof - { assume "c' + a' * (C / B)⇧2 - b' * (C / B) < 0" then have ?thesis by (simp add: assms(4) power2_eq_square) } moreover { assume "¬ c' + a' * (C / B)⇧2 - b' * (C / B) < 0" then have ?thesis by (simp add: power2_eq_square) } ultimately show ?thesis by fastforce qed finally have h1: "(c' * B⇧2 - b' * C * B + a' * C⇧2 < 0) = (a' * (C / B)⇧2 - b' * C / B + c' < 0)" . have "(c' * B⇧2 - b' * C * B + a' * C⇧2 = 0) = ((c' * B⇧2 - b' * C * B + a' * C⇧2)/(B⇧2) = 0)" by (simp add: assms(4)) also have "... = (((c' * B⇧2)/(B⇧2) - (b' * C * B)/(B⇧2) + (a' * C⇧2)/(B⇧2)) = 0)" by (metis (no_types, lifting) add_divide_distrib diff_divide_distrib ) also have "... = (a' * (C / B)⇧2 - b' * C / B + c' = 0)" proof - { assume "c' + a' * (C * (C / (B * B))) - b' * (C / B) ≠ 0" then have ?thesis by (simp add: assms(4) power2_eq_square) } moreover { assume "c' + a' * (C * (C / (B * B))) - b' * (C / B) = 0" then have ?thesis by (simp add: power2_eq_square) } ultimately show ?thesis by fastforce qed finally have h2 : "(c' * B⇧2 - b' * C * B + a' * C⇧2 = 0) = (a' * (C / B)⇧2 - b' * C / B + c' = 0)" . have h3 : "((b' * B - 2 * a' * C) * B < 0) = (b' < 2 * a' * C / B)" by (smt assms(4) less_divide_eq zero_le_mult_iff) have h4 : "(b' * B = 2 * a' * C) = (b' = 2 * a' * C / B)" by (simp add: assms(4) nonzero_eq_divide_eq) show ?thesis unfolding fields substInfinitesimalLinearUni.simps convertDerivativeUni.simps linearSubstitutionUni.simps map_atomUni.simps evalUni.simps evalUni_if aEvalUni.simps Rings.mult_zero_class.mult_zero_left Rings.mult_zero_class.mult_zero_right Groups.add_0 substInfinitesimalLinear.simps degreetwo simp liftmap.simps linear_substitution.simps eval_Or eval_And liftb liftc apply simp unfolding derivative_def degreetwo insertion_sub insertion_mult c'_insertion b'_insertion assms apply simp unfolding sum insertion_add insertion_mult insertion_pow insertion_neg assms unfolding b'_insertion2 c'_insertion a'_insertion unfolding Power.power_class.power.power_0 Groups.monoid_mult_class.mult_1_right Groups.cancel_comm_monoid_add_class.diff_zero Power.monoid_mult_class.power_one_right twominusone degreedeg1 apply simp unfolding insertion_mult assms simp_insertion_blob degreeblob unfolding insertion_mult insertion_sub assms otherblob apply simp unfolding otherblob h1 h2 h3 h4 unfolding lift00 insertion_neg assms insertion_isovarspars_free insertion_sum insertion_mult insertion_sub degree0isovarspar degree_isovarspar mult_one_right insertion_sum_var insertion_pow insertion_neg sum unfolding assms b'_insertion c'_insertion a'_insertion insertion_neg insertion_mult insertion_add insertion_pow apply simp by (smt assms(2) assms(3) b'_insertion h1 h2 h3 h4 insertion_mult insertion_sub mult_one_right simp_insertion_blob) qed qed qed lemma convert_substInfinitesimalLinear: assumes "convert_atom var a (xs'@x#xs) = Some(a')" assumes "insertion (nth_default 0 (xs'@x#xs)) b = B" assumes "insertion (nth_default 0 (xs'@x#xs)) c = C" assumes "B ≠ 0" assumes "var∉(vars b)" assumes "var∉(vars c)" assumes "length xs' = var" shows "eval (substInfinitesimalLinear var (-c) b a) (xs'@x#xs) = evalUni (substInfinitesimalLinearUni B C a') x" using assms proof(cases a) case (Less p) have "∃p'. convert_poly var p (xs'@x#xs) = Some p'" using Less assms(1) apply(cases "MPoly_Type.degree p var < 3") by auto then obtain p' where p'_def : "convert_poly var p (xs'@x#xs) = Some p'" by auto have A'_simp : "a' = LessUni p'" using assms Less using p'_def by auto have h1 : "eval (convertDerivative var p) (xs'@x#xs) = evalUni (convertDerivativeUni p') x" using convert_convertDerivative apply ( cases p') using A'_simp Less assms by auto show ?thesis unfolding A'_simp using convert_substInfinitesimalLinear_less[OF p'_def assms(2-7)] unfolding Less by auto next case (Eq p) define p' where "p' = (case convert_poly var p (xs'@x#xs) of Some p' ⇒ p')" have A'_simp : "a' = EqUni p'" using assms Eq using p'_def by auto show ?thesis unfolding Eq A'_simp substInfinitesimalLinear.simps substInfinitesimalLinearUni.simps using convert_allZero A'_simp Eq assms by auto next case (Leq p) have "∃p'. convert_poly var p (xs' @ x # xs) = Some p'" using assms(1) unfolding Leq apply auto apply(cases "MPoly_Type.degree p var < 3") by auto then obtain p' where p'_def : "convert_poly var p (xs' @ x # xs) = Some p'" by metis have A'_simp : "a' = LeqUni p'" using assms Leq using p'_def by auto have h1 : "eval (convertDerivative var p) (xs'@x#xs) = evalUni (convertDerivativeUni p') x" using convert_convertDerivative apply(cases p') using A'_simp Leq assms by auto show ?thesis unfolding A'_simp Leq substInfinitesimalLinear.simps eval_Or substInfinitesimalLinearUni.simps evalUni.simps using convert_substInfinitesimalLinear_less[OF p'_def assms(2-7)] convert_allZero[OF p'_def assms(7)] by simp next case (Neq p) have "∃p'. convert_poly var p (xs' @ x # xs) = Some p'" using assms(1) unfolding Neq apply auto apply(cases "MPoly_Type.degree p var < 3") by auto then obtain p' where p'_def : "convert_poly var p (xs' @ x # xs) = Some p'" by metis have A'_simp : "a' = NeqUni p'" using assms Neq using p'_def by auto show ?thesis unfolding Neq A'_simp substInfinitesimalLinear.simps substInfinitesimalLinearUni.simps using convert_allZero[OF p'_def assms(7)] by (metis A'_simp Neq assms(1) assms(7) convert_substNegInfinity eval.simps(6) eval_neg substNegInfinityUni.simps(4) substNegInfinity.simps(4)) qed lemma either_or: fixes r :: "real" assumes a: "(∃y'>r. ∀x∈{r<..y'}. (aEvalUni (EqUni (a, b, c)) x) ∨ (aEvalUni (LessUni (a, b, c)) x))" shows "(∃y'>r. ∀x∈{r<..y'}. (aEvalUni (EqUni (a, b, c)) x)) ∨ (∃y'>r. ∀x∈{r<..y'}. (aEvalUni (LessUni (a, b, c)) x))" proof (cases "a = 0 ∧ b = 0 ∧ c= 0") case True then have "(∃y'>r. ∀x∈{r<..y'}. (aEvalUni (EqUni (a, b, c)) x))" using assms by auto then show ?thesis by blast next case False then have noz: "a≠0 ∨ b≠0 ∨ c≠0" by auto obtain y1' where y1prop: "y1' > r ∧ (∀x∈{r<..y1'}. (aEvalUni (EqUni (a, b, c)) x) ∨ (aEvalUni (LessUni (a, b, c)) x))" using a by auto obtain y2' where y2prop: "y2' > r ∧ (∀x∈{r<..y2'}. a * x⇧2 + b * x + c ≠ 0)" using noz nonzcoeffs[of a b c] by auto let ?y = "min y1' y2'" have ygt: "?y > r" using y1prop y2prop by auto have "∀x∈{r<..?y}. (aEvalUni (LessUni (a, b, c)) x)" using y1prop y2prop greaterThanAtMost_iff by force then show ?thesis using ygt by blast qed lemma infinitesimal_linear'_helper : assumes at_is: "At = LessUni p ∨ At = EqUni p" assumes "B ≠ 0" shows "((∃y'::real>-C/B. ∀x::real ∈{-C/B<..y'}. aEvalUni At x) = evalUni (substInfinitesimalLinearUni B C At) x)" proof (cases "At = LessUni p") case True then have LessUni: "At = LessUni p" by auto then show ?thesis proof(cases p) case (fields a b c) then show ?thesis unfolding LessUni fields using one_root_a_lt0[where r="C/B", where a= "a", where b="b",where c= "c"] apply(auto) using continuity_lem_lt0_expanded[where a= "a", where b = "2 * a * C / B ", where c = "c"] apply (auto) using continuity_lem_gt0_expanded[where a = "a", where b = "2 * a * C / B",where c = "c", where r = "- (C / B)"] apply (auto) apply (meson less_eq_real_def linorder_not_less) using one_root_a_gt0[where r = "C/B", where a = "a", where b="b", where c="c"] apply (auto) using continuity_lem_lt0_expanded[where a= "a", where b = "2 * a * C / B", where c= "c"] apply (auto) using continuity_lem_gt0_expanded[where a = "a", where b = "2 * a * C / B",where c = "c", where r = "- (C / B)"] apply (auto) apply (meson less_eq_real_def linorder_not_less) using case_d1 apply (auto) using continuity_lem_lt0_expanded[where a= "a", where b = "b", where c= "c"] apply (auto) using continuity_lem_gt0_expanded[where a = "a", where b = "b",where c = "c", where r = "- (C / B)"] apply (auto) apply (meson less_eq_real_def linorder_not_less) using case_d4 apply (auto) using continuity_lem_lt0_expanded[where a= "a", where b = "b", where c= "c"] apply (auto) using continuity_lem_gt0_expanded[where a = "a", where b = "b",where c = "c", where r = "- (C / B)"] apply (auto) by (meson less_eq_real_def linorder_not_le) qed next case False then have EqUni: "At = EqUni p" using at_is by auto then show ?thesis proof(cases p) case (fields a b c) show ?thesis apply(auto simp add:EqUni fields) using continuity_lem_eq0[where r= "-(C/B)"] apply blast using continuity_lem_eq0[where r= "-(C/B)"] apply blast using continuity_lem_eq0[where r= "-(C/B)"] apply blast using linordered_field_no_ub by blast qed qed (* I assume substInfinitesimalLinearUni' was supposed to be substInfinitesimalLinearUni?*) lemma infinitesimal_linear' : assumes "B ≠ 0" shows "(∃y'::real>-C/B. ∀x::real ∈{-C/B<..y'}. aEvalUni At x) = evalUni (substInfinitesimalLinearUni B C At) x" proof(cases At) case (LessUni p) then show ?thesis using infinitesimal_linear'_helper[of At p B C] assms by auto next case (EqUni p) then show ?thesis using infinitesimal_linear'_helper[of At p B C] assms by (auto) next case (LeqUni p) then show ?thesis proof(cases p) case (fields a b c) have same: "∀x. aEvalUni (LeqUni p) x = (aEvalUni (EqUni p) x) ∨ (aEvalUni (LessUni p) x)" apply (simp add: fields) by force have "⋀a b c. At = LeqUni p ⟹ p = (a, b, c) ⟹ (∃y'>- C / B. ∀x∈{- C / B<..y'}. aEvalUni At x) = evalUni (substInfinitesimalLinearUni B C At) x " proof - fix a b c assume atis: "At = LeqUni p" assume p_is: " p = (a, b, c)" have s1: "(∃y'>- C / B. ∀x∈{- C / B<..y'}. aEvalUni At x) = (∃y'>- C / B. ∀x∈{- C / B<..y'}. (aEvalUni (EqUni p) x) ∨ (aEvalUni (LessUni p) x))" using atis same aEvalUni.simps(2) aEvalUni.simps(3) fields less_eq_real_def by blast have s2: "... = (∃y'>- C / B. ∀x∈{- C / B<..y'}. (aEvalUni (EqUni p) x)) ∨ (∃y'>- C / B. ∀x∈{- C / B<..y'}. (aEvalUni (LessUni p) x))" using either_or[where r = "-C/B"] p_is by blast have eq1: "(∃y'>- C / B. ∀x∈{- C / B<..y'}. (aEvalUni (EqUni p) x)) = (evalUni (substInfinitesimalLinearUni B C (EqUni p)) x)" using infinitesimal_linear'_helper[where At = "EqUni p", where p = "p", where B = "B", where C= "C"] assms by auto have eq2: "(∃y'>- C / B. ∀x∈{- C / B<..y'}. (aEvalUni (LessUni p) x)) = (evalUni (substInfinitesimalLinearUni B C (LessUni p)) x)" using infinitesimal_linear'_helper[where At = "LessUni p", where p = "p", where B = "B", where C= "C"] assms by auto have z1: "(∃y'>- C / B. ∀x∈{- C / B<..y'}. aEvalUni At x) = ((evalUni (substInfinitesimalLinearUni B C (EqUni p)) x) ∨ (evalUni (substInfinitesimalLinearUni B C (LessUni p)) x))" using s1 s2 eq1 eq2 by auto have z2: "(evalUni (substInfinitesimalLinearUni B C (EqUni p)) x) ∨ (evalUni (substInfinitesimalLinearUni B C (LessUni p)) x) = evalUni (substInfinitesimalLinearUni B C (LeqUni p)) x" by auto have z3: "(evalUni (substInfinitesimalLinearUni B C At) x) = evalUni (substInfinitesimalLinearUni B C (LeqUni p)) x" using LeqUni by auto then have z4: "(evalUni (substInfinitesimalLinearUni B C (EqUni p)) x) ∨ (evalUni (substInfinitesimalLinearUni B C (LessUni p)) x) = (evalUni (substInfinitesimalLinearUni B C At) x) " using z2 z3 by auto let ?a = "(evalUni (substInfinitesimalLinearUni B C (EqUni p)) x) ∨ (evalUni (substInfinitesimalLinearUni B C (LessUni p)) x)" let ?b = "(∃y'>- C / B. ∀x∈{- C / B<..y'}. aEvalUni At x)" let ?c = "(evalUni (substInfinitesimalLinearUni B C At) x)" have t1: "?b = ?a" using z1 by auto have t2: "?a = ?c" using z4 by (simp add: atis) then have "?b = ?c" using t1 t2 by auto then show "(∃y'>- C / B. ∀x∈{- C / B<..y'}. aEvalUni At x) = evalUni (substInfinitesimalLinearUni B C At) x" by auto qed then show ?thesis using LeqUni fields by blast qed next case (NeqUni p) then show ?thesis proof(cases p) case (fields a b c) then show ?thesis unfolding NeqUni fields using nonzcoeffs by (auto) qed qed fun quadraticSubUni :: "real ⇒ real ⇒ real ⇒ real ⇒ atomUni ⇒ atomUni fmUni" where "quadraticSubUni a b c d A = (if aEvalUni A ((a+b*sqrt(c))/d) then TrueFUni else FalseFUni)" fun substInfinitesimalQuadraticUni :: "real ⇒ real ⇒ real ⇒ real ⇒ atomUni ⇒ atomUni fmUni" where "substInfinitesimalQuadraticUni a b c d (EqUni p) = allZero' p"| "substInfinitesimalQuadraticUni a b c d (LessUni p) = map_atomUni (quadraticSubUni a b c d) (convertDerivativeUni p)"| "substInfinitesimalQuadraticUni a b c d (LeqUni p) = OrUni(map_atomUni (quadraticSubUni a b c d) (convertDerivativeUni p)) (allZero' p)"| "substInfinitesimalQuadraticUni a b c d (NeqUni p) = negUni (allZero' p)" lemma weird : fixes D::"real" assumes dneq: "D ≠ (0::real)" shows "((a'::real) * (((A::real) + (B::real) * sqrt (C::real)) / (D::real))⇧2 + (b'::real) * (A + B * sqrt C) / D + c' < 0 ∨ a' * ((A + B * sqrt C) / D)⇧2 + b' * (A + B * sqrt C) / D + (c'::real) = 0 ∧ (b' + a' * (A + B * sqrt C) * 2 / D < 0 ∨ b' + a' * (A + B * sqrt C) * 2 / D = 0 ∧ 2 * a' < 0)) = (a' * ((A + B * sqrt C) / D)⇧2 + b' * (A + B * sqrt C) / D + c' < 0 ∨ a' * ((A + B * sqrt C) / D)⇧2 + b' * (A + B * sqrt C) / D + c' = 0 ∧ (2 * a' * (A + B * sqrt C) / D + b' < 0 ∨ 2 * a' * (A + B * sqrt C) / D + b' = 0 ∧ a' < 0))" proof (cases "(a' * ((A + B * sqrt C) / D)⇧2 + b' * (A + B * sqrt C) / D + c' < 0)") case True then show ?thesis by auto next case False have "a' * (A + B * sqrt C) * 2 = 2 * a' * (A + B * sqrt C)" by auto then have "a' * (A + B * sqrt C) * 2 / D =2 * a' * (A + B * sqrt C) / D " using dneq by simp then have "b' + a' * (A + B * sqrt C) * 2 / D = 2 * a' * (A + B * sqrt C) / D + b'" using add.commute by simp then have "(b' + a' * (A + B * sqrt C) * 2 / D < 0 ∨ b' + a' * (A + B * sqrt C) * 2 / D = 0 ∧ a' < 0) = (2 * a' * (A + B * sqrt C) / D + b' < 0 ∨ 2 * a' * (A + B * sqrt C) / D + b' = 0 ∧ a' < 0)" by (simp add: ‹b' + a' * (A + B * sqrt C) * 2 / D = 2 * a' * (A + B * sqrt C) / D + b'›) then have "(a' * ((A + B * sqrt C) / D)⇧2 + b' * (A + B * sqrt C) / D + c' = 0 ∧ (b' + a' * (A + B * sqrt C) * 2 / D < 0 ∨ b' + a' * (A + B * sqrt C) * 2 / D = 0 ∧ a' < 0)) = (a' * ((A + B * sqrt C) / D)⇧2 + b' * (A + B * sqrt C) / D + c' = 0 ∧ (2 * a' * (A + B * sqrt C) / D + b' < 0 ∨ 2 * a' * (A + B * sqrt C) / D + b' = 0 ∧ a' < 0))" by blast then show ?thesis using False by simp qed lemma convert_substInfinitesimalQuadratic_less : assumes "convert_poly var p (xs'@x#xs) = Some p'" assumes "insertion (nth_default 0 (xs'@x#xs)) a = A" assumes "insertion (nth_default 0 (xs'@x#xs)) b = B" assumes "insertion (nth_default 0 (xs'@x#xs)) c = C" assumes "insertion (nth_default 0 (xs'@x#xs)) d = D" assumes "D ≠ 0" assumes "0 ≤ C" assumes "var∉(vars a)" assumes "var∉(vars b)" assumes "var∉(vars c)" assumes "var∉(vars d)" assumes "length xs' = var" shows "eval (quadratic_sub_fm var a b c d (convertDerivative var p)) (xs'@x#xs) = evalUni (map_atomUni (quadraticSubUni A B C D) (convertDerivativeUni p')) x" proof(cases p') case (fields a' b' c') have h : "convert_poly var p (xs'@x#xs) = Some (a', b', c')" using assms fields by auto have h2 : "∃F'. convert_fm var (convertDerivative var p) (xs'@x#xs) = Some F'" unfolding convertDerivative.simps[of _ p] convertDerivative.simps[of _ "derivative var p"] convertDerivative.simps[of _ "derivative var (derivative var p)"] apply (auto simp del: convertDerivative.simps) using degree_convert_eq h apply blast using assms(1) degree_convert_eq apply blast using degree_derivative apply fastforce apply (metis degree_convert_eq h numeral_3_eq_3 ) apply (metis (no_types, lifting) One_nat_def add.right_neutral add_Suc_right degree_derivative less_Suc_eq_0_disj less_Suc_eq_le neq0_conv numeral_3_eq_3) apply (metis One_nat_def Suc_eq_plus1 degree_derivative less_2_cases less_Suc_eq nat_neq_iff numeral_3_eq_3 one_add_one) apply (meson assms(1) degree_convert_eq) using degree_derivative apply fastforce using assms(1) degree_convert_eq apply blast apply (meson assms(1) degree_convert_eq) apply (metis degree_derivative less_Suc_eq less_add_one not_less_eq numeral_3_eq_3) apply (meson assms(1) degree_convert_eq) apply (metis (no_types, hide_lams) Suc_1 Suc_eq_plus1 degree_derivative less_2_cases less_Suc_eq numeral_3_eq_3) using assms(1) degree_convert_eq by blast have c'_insertion : "insertion (nth_default 0 (xs'@x#xs)) (isolate_variable_sparse p var 0) = c'" using assms fields unfolding convert_poly.simps apply(cases "MPoly_Type.degree p var < 3") by auto then have c'_insertion'' : "⋀x. insertion (nth_default 0 (xs' @ x # xs)) (isolate_variable_sparse p var 0) = c'" using assms(12) not_in_isovarspar[of p var 0 "isolate_variable_sparse p var 0", OF HOL.refl] by (metis list_update_length not_contains_insertion) have b'_insertion : "insertion (nth_default 0 (xs'@x#xs)) (isolate_variable_sparse p var (Suc 0)) = b'" using assms fields unfolding convert_poly.simps apply(cases "MPoly_Type.degree p var < 3") by auto then have b'_insertion'' : "⋀x. insertion (nth_default 0 (xs' @ x # xs)) (isolate_variable_sparse p var (Suc 0)) = b'" using assms(12) not_in_isovarspar[of p var "Suc 0" "isolate_variable_sparse p var (Suc 0)", OF HOL.refl] by (metis list_update_length not_contains_insertion) then have b'_insertion2 : "insertion (nth_default 0 (xs'@x#xs)) (isolate_variable_sparse p var 1) = b'" by auto have a'_insertion : "insertion (nth_default 0 (xs'@x#xs)) (isolate_variable_sparse p var 2) = a'" using assms fields unfolding convert_poly.simps apply(cases "MPoly_Type.degree p var < 3") by auto then have a'_insertion'' : "⋀x. insertion (nth_default 0 (xs' @ x # xs)) (isolate_variable_sparse p var 2) = a'" using assms(12) not_in_isovarspar[of p var 2 "isolate_variable_sparse p var 2", OF HOL.refl] by (metis list_update_length not_contains_insertion) have liftb : "liftPoly 0 0 b = b" using lift00 by auto have liftc : "liftPoly 0 0 c = c" using lift00 by auto have b'_insertion' : "insertion (nth_default 0 (xs'@x#xs)) (isolate_variable_sparse (isolate_variable_sparse p var (Suc 0)) var 0) = b'" using assms fields unfolding convert_poly.simps apply(cases "MPoly_Type.degree p var < 3") apply auto using degree0isovarspar degree_isovarspar by auto have insertion_into_1 : "insertion (nth_default 0 (xs'@x#xs)) (isolate_variable_sparse (Const 1) var 0) = 1" by (simp add: const_lookup_zero insertion_const) have twominusone : "((2-1)::nat) = 1" by auto have length0 : "var < length (xs'@x#xs)" using assms by auto have altinserta : "∀xa. insertion (nth_default 0 ((xs'@x#xs)[var := xa])) a = A" using assms by (metis list_update_length not_contains_insertion) have altinserta' : "⋀xa. insertion (nth_default 0 ((xs'@x#xs)[var := xa])) a = A" using assms by (metis list_update_length not_contains_insertion) have altinsertb : "∀xa. insertion (nth_default 0 ((xs'@x#xs)[var := xa])) b = B" using assms by (metis list_update_length not_contains_insertion) have altinsertb' : "⋀xa. insertion (nth_default 0 ((xs'@x#xs)[var := xa])) b = B" using assms by (metis list_update_length not_contains_insertion) have altinsertc : "∀xa. insertion (nth_default 0 ((xs'@x#xs)[var := xa])) c = C" using assms by (metis list_update_length not_contains_insertion) have altinsertc' : "⋀xa. insertion (nth_default 0 ((xs'@x#xs)[var := xa])) c = C" using assms by (metis list_update_length not_contains_insertion) have altinsertd : "∀xa. insertion (nth_default 0 ((xs'@x#xs)[var := xa])) d = D" using assms by (metis list_update_length not_contains_insertion) have altinsertd' : "⋀xa. insertion (nth_default 0 ((xs'@x#xs)[var := xa])) d = D" using assms by (metis list_update_length not_contains_insertion) have freeInQuadraticSub : "∀At. eval (quadratic_sub var a b c d At) ((xs'@x#xs)[var := sqrt C]) = eval (quadratic_sub var a b c d At) ((xs'@x#xs))" by (metis assms(10) assms(11) assms(8) assms(9) free_in_quad list_update_id var_not_in_eval) have quad : "⋀At. (eval (quadratic_sub var a b c d At) (xs'@x#xs) = aEval At ((xs'@x#xs)[var := (A + B * sqrt C) / D]))" using quadratic_sub[OF length0 assms(6-7) assms(10) altinserta altinsertb altinsertc altinsertd, symmetric] using freeInQuadraticSub by auto show ?thesis proof(cases "MPoly_Type.degree p var = 0") case True then have simp: "(convertDerivative var p)=Atom(Less p)" by auto have azero : "a'=0" by (metis MPoly_Type.insertion_zero True a'_insertion isolate_variable_sparse_ne_zeroD nat.simps(3) not_less numeral_2_eq_2 zero_less_iff_neq_zero) have bzero : "b'=0" using True b'_insertion isovar_greater_degree by fastforce define p1 where "p1 = isolate_variable_sparse p var 0" have degree_p1: "MPoly_Type.degree p1 var = 0" unfolding p1_def by (simp add: degree_isovarspar) define p2 where "p2 = isolate_variable_sparse p1 var 0 * Const 0 * Var var + isolate_variable_sparse p1 var 0 * Const 1" define A where "A = isolate_variable_sparse p2 var 0" define B where "B = isolate_variable_sparse p2 var (Suc 0)" show ?thesis unfolding substInfinitesimalQuadratic.simps substInfinitesimalQuadraticUni.simps fields convertDerivativeUni.simps map_atomUni.simps quadraticSubUni.simps aEvalUni.simps evalUni.simps evalUni_if Rings.mult_zero_class.mult_zero_left Groups.add_0 Rings.mult_zero_class.mult_zero_right True simp azero bzero quadratic_sub_fm.simps quadratic_sub_fm_helper.simps liftmap.simps lift00 quad aEval.simps apply (simp add:True c'_insertion p1_def[symmetric] degree_p1 p2_def[symmetric] A_def[symmetric] B_def[symmetric]) unfolding A_def B_def p2_def p1_def degree0isovarspar[OF True] isovarspar_sum mult_one_right mult_zero_right mult_zero_left const_lookup_zero const_lookup_suc apply simp unfolding insertion_add insertion_sub insertion_mult insertion_pow insertion_const c'_insertion apply simp using ‹isolate_variable_sparse p var 0 = p› b'_insertion2 bzero c'_insertion by force next case False then have degreenonzero : "MPoly_Type.degree p var ≠0" by auto show ?thesis proof(cases "MPoly_Type.degree p var = 1") case True then have simp : "convertDerivative var p = Or (fm.Atom (Less p)) (And (fm.Atom (Eq p)) (fm.Atom (Less (derivative var p))))" by (metis One_nat_def Suc_eq_plus1 add_right_imp_eq convertDerivative.simps degree_derivative degreenonzero less_numeral_extra(1)) have azero : "a'=0" by (metis MPoly_Type.insertion_zero One_nat_def True a'_insertion isovar_greater_degree lessI numeral_2_eq_2) have degderiv : "MPoly_Type.degree (isolate_variable_sparse p var (Suc 0) * Const 1) var = 0" using degree_mult by (simp add: degree_isovarspar mult_one_right) have thing : "var<length (xs'@((A + B * sqrt C) / D # xs))" using assms by auto have insertp : "insertion (nth_default 0 (xs'@((A + B * sqrt C) / D # xs))) p = b' * (A + B * sqrt C) / D + c'" using sum_over_degree_insertion[OF thing True, of "(A + B * sqrt C) / D", symmetric] unfolding list_update_length assms(12)[symmetric] apply simp unfolding assms(12) unfolding c'_insertion'' b'_insertion'' by auto have insertb : "insertion (nth_default 0 (xs'@(A + B * sqrt C) / D # xs)) (isolate_variable_sparse p var (Suc 0) * Const 1) = b'" unfolding insertion_mult insertion_const b'_insertion'' by simp show ?thesis unfolding substInfinitesimalQuadratic.simps substInfinitesimalQuadraticUni.simps fields convertDerivativeUni.simps map_atomUni.simps quadraticSubUni.simps aEvalUni.simps evalUni.simps evalUni_if Rings.mult_zero_class.mult_zero_left Groups.add_0 Rings.mult_zero_class.mult_zero_right True simp azero quadratic_sub_fm.simps quadratic_sub_fm_helper.simps liftmap.simps lift00 quad aEval.simps eval.simps derivative_def Groups.monoid_add_class.add_0_right apply simp unfolding insertp insertb insertion_mult insertion_const using assms(12) b'_insertion'' insertp by force next case False then have degree2 : "MPoly_Type.degree p var = 2" using degreenonzero using h less_Suc_eq by fastforce have simp : "(convertDerivative var p) = Or (fm.Atom (Less p)) (And (fm.Atom (Eq p)) (Or (fm.Atom (Less (derivative var p))) (And (fm.Atom (Eq (derivative var p))) (fm.Atom (Less (derivative var (derivative var p)))))))" by (metis One_nat_def Suc_eq_plus1 add_diff_cancel_right' convertDerivative.simps degree2 degree_derivative degreenonzero neq0_conv one_add_one) have insertionp : "var < length (xs'@(A + B * sqrt C) / D # xs)" using assms by auto have three : "3 = Suc(Suc(Suc(0)))" by auto have two : "2 = Suc(Suc(0))" by auto have insertionp : "insertion (nth_default 0 ((xs'@x # xs)[var := (A + B * sqrt C) / D])) p = a' * ((A + B * sqrt C) / D)⇧2 + b' * (A + B * sqrt C) / D + c'" using sum_over_degree_insertion[OF insertionp degree2, of "(A + B * sqrt C) / D", symmetric] unfolding a'_insertion[symmetric] b'_insertion[symmetric] c'_insertion[symmetric] insertion_isovarspars_free[of _ _ "(A + B * sqrt C) / D" _ _ x] unfolding two apply simp using assms(12) by force have insertion_simp : "insertion (nth_default 0 ((xs' @ x # xs)[var := (A + B * sqrt C) / D])) = insertion (nth_default 0 ((xs' @ ((A + B * sqrt C) / D) # xs)))" using assms by (metis list_update_length) have degreeone : "MPoly_Type.degree (isolate_variable_sparse p var (Suc 0) * Const 1 + isolate_variable_sparse p var (Suc (Suc 0)) * Var var * Const 2) var = 1" apply(rule degree_less_sum'[where n=0]) apply (simp add: degree_isovarspar mult_one_right) apply (smt One_nat_def ExecutiblePolyProps.degree_one degree2 degree_const degree_isovarspar degree_mult degreenonzero isolate_variable_sparse_degree_eq_zero_iff mult.commute nonzero_const_is_nonzero numeral_2_eq_2 plus_1_eq_Suc) by simp have zero1 : " insertion (nth_default 0 (xs' @ (A + B * sqrt C) / D # xs)) (isolate_variable_sparse (isolate_variable_sparse p var (Suc 0)) var (Suc 0)) = 0" by (simp add: degree_isovarspar isovar_greater_degree) have zero2 : "insertion (nth_default 0 (xs' @ (A + B * sqrt C) / D # xs)) (isolate_variable_sparse (isolate_variable_sparse p var (Suc (Suc 0))) var 0) = a'" using a'_insertion'' degree0isovarspar degree_isovarspar numeral_2_eq_2 by force have zero3 : "insertion (nth_default 0 (xs' @ (A + B * sqrt C) / D # xs)) (isolate_variable_sparse (Var var) var (Suc 0)) = 1" using isolate_var_one by fastforce have zero4 : "insertion (nth_default 0 (xs' @ (A + B * sqrt C) / D # xs)) (isolate_variable_sparse (isolate_variable_sparse p var (Suc (Suc 0))) var (Suc 0)) = 0" by (simp add: degree_isovarspar isovar_greater_degree) have insertiona' : " insertion (nth_default 0 (xs' @ (A + B * sqrt C) / D # xs)) (isolate_variable_sparse (isolate_variable_sparse p var (Suc 0) * Const 1 + isolate_variable_sparse p var (Suc (Suc 0)) * Var var * Const 2) var (Suc 0) * Const 1) = 2 * a'" unfolding isovarspar_sum isolate_variable_sparse_mult apply auto unfolding const_lookup_suc const_lookup_zero Rings.mult_zero_class.mult_zero_right Groups.group_add_class.add.group_left_neutral unfolding insertion_add insertion_mult insertion_const b'_insertion' apply auto unfolding zero1 zero2 zero3 zero4 by auto have a' : "insertion (nth_default 0 (xs' @ (A + B * sqrt C) / D # xs)) (isolate_variable_sparse p var (Suc (Suc 0))) = a'" unfolding two[symmetric] unfolding a'_insertion'' by auto have var: "insertion (nth_default 0 (xs' @ (A + B * sqrt C) / D # xs)) (Var var) = (A + B * sqrt C) / D" using assms by (metis insertion_simp insertion_var length0) show ?thesis unfolding substInfinitesimalQuadratic.simps substInfinitesimalQuadraticUni.simps fields convertDerivativeUni.simps map_atomUni.simps quadraticSubUni.simps aEvalUni.simps evalUni.simps evalUni_if Rings.mult_zero_class.mult_zero_left Groups.add_0 Rings.mult_zero_class.mult_zero_right degree2 simp quadratic_sub_fm.simps quadratic_sub_fm_helper.simps liftmap.simps lift00 Groups.monoid_add_class.add_0_right quad aEval.simps eval.simps derivative_def apply (simp add:insertion_sum insertion_add insertion_mult insertion_const insertion_var_zero) unfolding insertionp unfolding insertion_simp unfolding b'_insertion'' a'_insertion'' unfolding degreeone apply simp unfolding a' var unfolding insertiona' using weird[OF assms(6)] by auto qed qed qed lemma convert_substInfinitesimalQuadratic: assumes "convert_atom var At (xs'@ x#xs) = Some(At')" assumes "insertion (nth_default 0 (xs'@ x#xs)) a = A" assumes "insertion (nth_default 0 (xs'@ x#xs)) b = B" assumes "insertion (nth_default 0 (xs'@ x#xs)) c = C" assumes "insertion (nth_default 0 (xs'@ x#xs)) d = D" assumes "D ≠ 0" assumes "0 ≤ C" assumes "var∉(vars a)" assumes "var∉(vars b)" assumes "var∉(vars c)" assumes "var∉(vars d)" assumes "length xs' = var" shows "eval (substInfinitesimalQuadratic var a b c d At) (xs'@ x#xs) = evalUni (substInfinitesimalQuadraticUni A B C D At') x" using assms proof(cases At) case (Less p) define p' where "p' = (case convert_poly var p (xs'@ x#xs) of Some p' ⇒ p')" have At'_simp : "At' = LessUni p'" using assms Less using p'_def by auto show ?thesis using convert_substInfinitesimalQuadratic_less[OF _ assms(2-12)] by (metis At'_simp Less None_eq_map_option_iff assms(1) convert_atom.simps(1) option.distinct(1) option.exhaust_sel option.the_def p'_def substInfinitesimalQuadraticUni.simps(2) substInfinitesimalQuadratic.simps(2)) next case (Eq p) define p' where "p' = (case convert_poly var p (xs'@ x#xs) of Some p' ⇒ p')" have At'_simp : "At' = EqUni p'" using assms Eq using p'_def by auto show ?thesis unfolding At'_simp Eq substInfinitesimalQuadraticUni.simps substInfinitesimalQuadratic.simps using At'_simp Eq assms(1) convert_substNegInfinity assms(12) by fastforce next case (Leq p) define p' where "p' = (case convert_poly var p (xs'@ x#xs) of Some p' ⇒ p')" have At'_simp : "At' = LeqUni p'" using assms Leq using p'_def by auto have allzero : "eval (allZero p var) (xs'@ x#xs) = evalUni (allZero' p') x" using Leq assms(1) convert_allZero p'_def assms(12) by force have less : "eval (quadratic_sub_fm var a b c d (convertDerivative var p)) (xs'@ x#xs) = evalUni (map_atomUni (quadraticSubUni A B C D) (convertDerivativeUni p')) x" using convert_substInfinitesimalQuadratic_less[OF _ assms(2-12)] by (metis Leq assms(1) convert_atom.simps(3) option.distinct(1) option.exhaust_sel option.map(1) option.the_def p'_def) show ?thesis unfolding At'_simp Leq substInfinitesimalQuadraticUni.simps substInfinitesimalQuadratic.simps eval.simps evalUni.simps using allzero less by auto next case (Neq p) define p' where "p' = (case convert_poly var p (xs'@ x#xs) of Some p' ⇒ p')" have At'_simp : "At' = NeqUni p'" using assms Neq using p'_def by auto show ?thesis unfolding At'_simp Neq substInfinitesimalQuadraticUni.simps substInfinitesimalQuadratic.simps by (metis assms(12) At'_simp Neq assms(1) convert_substNegInfinity eval.simps(6) eval_neg substNegInfinityUni.simps(4) substNegInfinity.simps(4)) qed lemma infinitesimal_quad_helper: fixes A B C D:: "real" assumes at_is: "At = LessUni p ∨ At = EqUni p" assumes "D≠0" assumes "C≥0" shows "(∃y'::real>((A+B * sqrt(C))/(D)). ∀x::real ∈{((A+B * sqrt(C))/(D))<..y'}. aEvalUni At x) = (evalUni (substInfinitesimalQuadraticUni A B C D At) x)" proof(cases "At = LessUni p") case True then have LessUni: "At = LessUni p" by auto then show ?thesis proof(cases p) case (fields a b c) show ?thesis proof(cases "2 * (a::real) * (A + B * sqrt C) / D + b = 0") case True then have True1 : "2 * a * (A + B * sqrt C) / D + b = 0" by auto show ?thesis proof(cases "a * ((A + B * sqrt C) / D)⇧2 + b * (A + B * sqrt C) / D + c = 0") case True then have True2 : "a * ((A + B * sqrt C) / D)⇧2 + b * (A + B * sqrt C) / D + c = 0" by auto then show ?thesis proof(cases "a<0") case True then show ?thesis unfolding LessUni fields apply (simp add:True1 True2 True) using True1 True2 True proof - assume beq: "2 * a * (A + B * sqrt C) / D + b = 0" assume root: "a * ((A + B * sqrt C) / D)⇧2 + b * (A + B * sqrt C) / D + c = 0" assume alt: "a < 0 " let ?r = "-((A + B * sqrt C) / D)" have beq_var: "b = 2 * a * ?r" using beq by auto have root_var: " a * ?r^2 - 2*a*?r*?r + c = 0" using root by (simp add: beq_var) have "∃y'>- ?r. ∀x∈{- ?r<..y'}. a * x⇧2 + 2 * a *?r * x + c < 0" using beq_var root_var alt one_root_a_lt0[where a = "a", where b="b", where c="c", where r="?r"] by auto then show "∃y'>(A + B * sqrt C) / D. ∀x∈{(A + B * sqrt C) / D<..y'}. a * x⇧2 + b * x + c < 0" using beq_var by auto qed next case False then show ?thesis unfolding LessUni fields apply (simp add:True1 True2 False) using True1 True2 False proof clarsimp fix y' assume beq: " 2 * a * (A + B * sqrt C) / D + b = 0" assume root: " a * ((A + B * sqrt C) / D)⇧2 + b * (A + B * sqrt C) / D + c = 0" assume agteq: "¬ a < 0 " assume y_prop: "(A + B * sqrt C) / D < y'" have beq_var: "b = 2 * a * (- A - B * sqrt C) / D" using beq by (metis (no_types, hide_lams) ab_group_add_class.ab_diff_conv_add_uminus add.left_neutral add_diff_cancel_left' divide_inverse mult.commute mult_minus_right) have root_var: " a * ((- A - B * sqrt C) / D)⇧2 - 2 * a * (- A - B * sqrt C) * (- A - B * sqrt C) / (D * D) + c = 0" using root proof - have f1: "⋀r ra. - ((r::real) + ra) = - r - ra" by auto have f2: "⋀r ra. r * (a * 2 * (- A - B * sqrt C)) / (ra * D) = r / (ra / b)" by (simp add: beq_var) have f3: "c - 0 + a * ((A + B * sqrt C) / D)⇧2 = - (b * (A + B * sqrt C) / D)" using root by force have f4: "⋀r ra rb. ((- (r::real) - ra) / rb)⇧2 = ((r + ra) / rb)⇧2" using f1 by (metis (no_types) divide_minus_left power2_minus) have "⋀r ra rb rc. - ((r::real) * (ra + rb) / rc) = r * (- ra - rb) / rc" using f1 by (metis divide_divide_eq_right divide_minus_left mult.commute) then show ?thesis using f4 f3 f2 by (simp add: mult.commute) qed have y_prop_var: "- ((- A - B * sqrt C) / D) < y'" using y_prop by (metis add.commute diff_minus_eq_add divide_minus_left minus_diff_eq) have "∃x∈{- (- (A + B * sqrt C) / D)<..y'}. ¬ a * x⇧2 + 2 * a * (- (A + B * sqrt C) / D) * x + c < 0" using y_prop_var beq_var root_var agteq one_root_a_gt0[where a = "a", where b ="b", where c = "c", where r= "-(A + B * sqrt C) / D"] by auto then show " ∃x∈{(A + B * sqrt C) / D<..y'}. ¬ a * x⇧2 + b * x + c < 0" proof - have f1: "2 * a * (A + B * sqrt C) * inverse D + b = 0" by (metis True1 divide_inverse) obtain rr :: real where f2: "rr ∈ {- (- (A + B * sqrt C) / D)<..y'} ∧ ¬ a * rr⇧2 + 2 * a * (- (A + B * sqrt C) / D) * rr + c < 0" using ‹∃x∈{- (- (A + B * sqrt C) / D)<..y'}. ¬ a * x⇧2 + 2 * a * (- (A + B * sqrt C) / D) * x + c < 0› by blast have f3: "a * ((A + B * sqrt C) * (inverse D * 2)) = - b" using f1 by linarith have f4: "∀r. - (- (r::real)) = r" by simp have f5: "∀r ra. (ra::real) * - r = r * - ra" by simp have f6: "a * ((A + B * sqrt C) * (inverse D * - 2)) = b" using f3 by simp have f7: "∀r ra rb. (rb::real) * (ra * r) = r * (rb * ra)" by auto have f8: "∀r ra. - (ra::real) * r = ra * - r" by linarith then have f9: "a * (inverse D * ((A + B * sqrt C) * - 2)) = b" using f7 f6 f5 by presburger have f10: "rr ∈ {inverse D * (A + B * sqrt C)<..y'}" using f4 f2 by (metis (no_types) divide_inverse mult.commute mult_minus_right) have "¬ c + (rr * b + a * rr⇧2) < 0" using f9 f8 f7 f2 by (metis (no_types) add.commute divide_inverse mult.commute mult_minus_right) then show ?thesis using f10 by (metis (no_types) add.commute divide_inverse mult.commute) qed qed qed next case False then have False1 : "a * ((A + B * sqrt C) / D)⇧2 + b * (A + B * sqrt C) / D + c ≠ 0" by auto show ?thesis proof(cases "a * ((A + B * sqrt C) / D)⇧2 + b * (A + B * sqrt C) / D + c < 0") case True show ?thesis unfolding LessUni fields apply (simp add: True1 True) using True1 True proof - let ?r = "(A + B * sqrt C) / D" assume " 2 * a * (A + B * sqrt C) / D + b = 0" assume "a * ((A + B * sqrt C) / D)⇧2 + b * (A + B * sqrt C) / D + c < 0 " then have " ∃y'>(A + B * sqrt C) / D. ∀x∈{(A + B * sqrt C) / D<..y'}. poly [:c, b, a:] x < 0" using continuity_lem_lt0[where r= "(A + B * sqrt C) / D", where c = "c", where b = "b", where a="a"] quadratic_poly_eval[of c b a ?r] by auto then show "∃y'>(A + B * sqrt C) / D. ∀x∈{(A + B * sqrt C) / D<..y'}. a * x⇧2 + b * x + c < 0" using quadratic_poly_eval[of c b a] by fastforce qed next case False then have False' : "a * ((A + B * sqrt C) / D)⇧2 + b * (A + B * sqrt C) / D + c > 0" using False1 by auto show ?thesis unfolding LessUni fields apply(simp add: True1 False False1) using True1 False' continuity_lem_gt0_expanded[where a = "a", where b = "b",where c = "c", where r = "((A + B * sqrt C) / D)"] by (metis mult_less_0_iff not_square_less_zero times_divide_eq_right) qed qed next case False then have False1 : "2 * a * (A + B * sqrt C) / D + b ≠ 0" by auto have c1: "a * ((A + B * sqrt C) / D)⇧2 + b * (A + B * sqrt C) / D + c = 0 ⟹ 2 * a * (A + B * sqrt C) / D + b < 0 ⟹ ∃y'>(A + B * sqrt C) / D. ∀x∈{(A + B * sqrt C) / D<..y'}. a * x⇧2 + b * x + c < 0" proof - assume root: "a * ((A + B * sqrt C) / D)⇧2 + b * (A + B * sqrt C) / D + c = 0" assume blt: " 2 * a * (A + B * sqrt C) / D + b < 0" let ?r = "-(A + B * sqrt C) / D" have bltvar: "b < 2 * a * ?r" using blt divide_minus_left mult_2 mult_minus_right real_add_less_0_iff by (metis times_divide_eq_right) have rootvar: "a * ?r^2 - b * ?r + c = 0" using root proof - have f1: "∀r ra. - (ra::real) * r = ra * - r" by simp have f2: "∀r ra. ((ra::real) * - r)⇧2 = (ra * r)⇧2" by simp have f3: "a * (inverse D * (A - B * - sqrt C))⇧2 - inverse D * (b * - (A - B * - sqrt C)) - - c = 0" by (metis (no_types) diff_minus_eq_add divide_inverse mult.commute mult_minus_left root) have f4: "∀r ra rb. (rb::real) * (ra * r) = ra * (r * rb)" by simp have "∀r ra. (ra::real) * - r = r * - ra" by simp then have "a * (inverse D * (A - B * - sqrt C))⇧2 - b * (inverse D * - (A - B * - sqrt C)) - - c = 0" using f4 f3 f1 by (metis (no_types)) then have "a * (inverse D * - (A - B * - sqrt C))⇧2 - b * (inverse D * - (A - B * - sqrt C)) - - c = 0" using f2 by presburger then show ?thesis by (simp add: divide_inverse mult.commute) qed have "∃y'> ((A + B * sqrt C) / D). ∀x∈{((A + B * sqrt C) / D)<..y'}. a * x⇧2 + b * x + c < 0" using rootvar bltvar case_d1[where a= "a", where b = "b", where c = "c", where r = ?r] by (metis add.inverse_inverse divide_inverse mult_minus_left) then show ?thesis by blast qed have c2: " ⋀y'. a * ((A + B * sqrt C) / D)⇧2 + b * (A + B * sqrt C) / D + c = 0 ⟹ ¬ 2 * a * (A + B * sqrt C) / D + b < 0 ⟹ (A + B * sqrt C) / D < y' ⟹ ∃x∈{(A + B * sqrt C) / D<..y'}. ¬ a * x⇧2 + b * x + c < 0" proof - let ?r = "(A + B * sqrt C) / D" fix y' assume h1: "a * ((A + B * sqrt C) / D)⇧2 + b * (A + B * sqrt C) / D + c = 0" assume h2: "¬ 2 * a * (A + B * sqrt C) / D + b < 0" assume h3: " (A + B * sqrt C) / D < y'" have eq: "2 * a * (A + B * sqrt C) / D + b = 0 ⟹ ∃x∈{(A + B * sqrt C) / D..y'}. ¬ a * x⇧2 + b * x + c < 0" using False1 by blast have "2 * a * (A + B * sqrt C) / D + b > 0 ⟹ ∃x∈{?r<..y'}. ¬ a * x⇧2 + b * x + c < 0" using case_d4[where a = "a", where b = "b", where c= "c", where r = "-?r"] h1 h2 h3 by auto then show "∃x∈{(A + B * sqrt C) / D<..y'}. ¬ a * x⇧2 + b * x + c < 0" using h2 eq using False1 by linarith qed have c3: "((a::real) * ((A + B * sqrt C) / D)⇧2 + b * (A + B * sqrt C) / D + c < 0) ⟶ (∃y'>((A + B * sqrt C) / D). ∀x∈{(A + B * sqrt C) / D<..y'}. a * x⇧2 + b * x + c < 0)" proof clarsimp assume assump: "a * ((A + B * sqrt C) / D)⇧2 + b * (A + B * sqrt C) / D + c < 0 " have "a * ((A + B * sqrt C) / D)⇧2 + b * ((A + B * sqrt C) / D) + c < 0 ⟹ ∃y'>(A + B * sqrt C) / D. ∀x∈{(A + B * sqrt C) / D<..y'}. a * x⇧2 + b * x + c < 0" using continuity_lem_lt0_expanded[where a= "a", where b = "b", where c = "c", where r = "((A + B * sqrt C) / D)::real"] by auto then have "∃y'>(A + B * sqrt C) / D. ∀x∈{(A + B * sqrt C) / D<..y'}. a * x⇧2 + b * x + c < 0" using assump by auto then obtain y where y_prop: "y >(A + B * sqrt C) / D ∧ (∀x∈{(A + B * sqrt C) / D<..y}. a * x⇧2 + b * x + c < 0)" by auto then have h: "∃ k. k >(A + B * sqrt C) / D ∧ k < y" using dense by blast then obtain k where k_prop: "k >(A + B * sqrt C) / D ∧ k < y" by auto then have "∀x∈{(A + B * sqrt C) / D..k}. a * x⇧2 + b * x + c < 0" using y_prop using assump by force then show "∃y'>((A + B * sqrt C) / D::real). ∀x∈{(A + B * sqrt C) / D<..y'}. a * x⇧2 + b * x + c < 0" using k_prop by auto qed have c4: "⋀y'. a * ((A + B * sqrt C) / D)⇧2 + b * (A + B * sqrt C) / D + c ≠ 0 ⟹ ¬ a * ((A + B * sqrt C) / D)⇧2 + b * (A + B * sqrt C) / D + c < 0 ⟹ (A + B * sqrt C) / D < y' ⟹ ∃x∈{(A + B * sqrt C) / D<..y'}. ¬ a * x⇧2 + b * x + c < 0" using continuity_lem_gt0_expanded[where a= "a", where b = "b", where c = "c", where r= "(A + B * sqrt C) / D"] by (metis Groups.mult_ac(1) divide_inverse less_eq_real_def linorder_not_le) show ?thesis unfolding LessUni fields apply(simp add: False1) using c1 c2 c3 c4 by auto qed qed next case False then have EqUni: "At = EqUni p" using at_is by auto then show ?thesis proof(cases p) case (fields a b c) have " ⋀y'. (A + B * sqrt C) / D < y' ⟹ ∀x∈{(A + B * sqrt C) / D<..y'}. a * x⇧2 + b * x + c = 0 ⟹ (a = 0 ∧ b = 0 ∧ c = 0)" proof - fix y' assume "(A + B * sqrt C) / D < y'" then show " ∀x∈{(A + B * sqrt C) / D<..y'}. a * x⇧2 + b * x + c = 0 ⟹ (a = 0 ∧ b = 0 ∧ c = 0)" using assms continuity_lem_eq0[where r = "(A + B * sqrt C) / D", where p = "y'", where a= "a", where b ="b", where c="c"] by auto qed then show ?thesis apply (auto simp add:EqUni fields ) using linordered_field_no_ub by blast qed qed lemma infinitesimal_quad: fixes A B C D:: "real" assumes "D≠0" assumes "C≥0" shows "(∃y'::real>((A+B * sqrt(C))/(D)). ∀x::real ∈{((A+B * sqrt(C))/(D))<..y'}. aEvalUni At x) = (evalUni (substInfinitesimalQuadraticUni A B C D At) x)" proof(cases At) case (LessUni p) then show ?thesis using infinitesimal_quad_helper assms by blast next case (EqUni p) then show ?thesis using infinitesimal_quad_helper assms by blast next case (LeqUni p) then show ?thesis proof (cases p) case (fields a b c) have same: "∀x. aEvalUni (LeqUni p) x = (aEvalUni (EqUni p) x) ∨ (aEvalUni (LessUni p) x)" apply (simp add: fields) by force let ?r = "(A + B * sqrt C) / D" have "⋀a b c. At = LeqUni p ⟹ p = (a, b, c) ⟹ (∃y'>(A + B * sqrt C) / D. ∀x∈{(A + B * sqrt C) / D<..y'}. aEvalUni At x) = evalUni (substInfinitesimalQuadraticUni A B C D At) x" proof - fix a b c assume atis: "At = LeqUni p" assume p_is: " p = (a, b, c)" have s1: "(∃y'>?r. ∀x∈{?r<..y'}. aEvalUni At x) = (∃y'>?r. ∀x∈{?r<..y'}. (aEvalUni (EqUni p) x) ∨ (aEvalUni (LessUni p) x))" using atis same aEvalUni.simps(2) aEvalUni.simps(3) fields less_eq_real_def by blast have s2: "... = (∃y'>?r. ∀x∈{?r<..y'}. (aEvalUni (EqUni p) x)) ∨ (∃y'>?r. ∀x∈{?r<..y'}. (aEvalUni (LessUni p) x))" using either_or[where r = "?r"] p_is by blast have eq1: "(∃y'>?r. ∀x∈{?r<..y'}. (aEvalUni (EqUni p) x)) = (evalUni (substInfinitesimalQuadraticUni A B C D (EqUni p)) x)" using infinitesimal_quad_helper[where At = "EqUni p", where p = "p", where B = "B", where C= "C", where A= "A", where D="D"] assms by auto have eq2: "(∃y'>?r. ∀x∈{?r<..y'}. (aEvalUni (LessUni p) x)) = (evalUni (substInfinitesimalQuadraticUni A B C D (LessUni p)) x)" using infinitesimal_quad_helper[where At = "LessUni p", where p = "p", where B = "B", where C= "C", where A= "A", where D="D"] assms by auto have z1: "(∃y'>?r. ∀x∈{?r<..y'}. aEvalUni At x) = ((evalUni (substInfinitesimalQuadraticUni A B C D (EqUni p)) x) ∨ (evalUni (substInfinitesimalQuadraticUni A B C D (LessUni p)) x))" using s1 s2 eq1 eq2 by auto have z2: "(evalUni (substInfinitesimalQuadraticUni A B C D (EqUni p)) x) ∨ (evalUni (substInfinitesimalQuadraticUni A B C D (LessUni p)) x) = evalUni (substInfinitesimalQuadraticUni A B C D (LeqUni p)) x" by auto have z3: "(evalUni (substInfinitesimalQuadraticUni A B C D At) x) = evalUni (substInfinitesimalQuadraticUni A B C D (LeqUni p)) x" using LeqUni by auto then have z4: "(evalUni (substInfinitesimalQuadraticUni A B C D (EqUni p)) x) ∨ (evalUni (substInfinitesimalQuadraticUni A B C D (LessUni p)) x) = (evalUni (substInfinitesimalQuadraticUni A B C D At) x) " using z2 z3 by auto let ?a = "(evalUni (substInfinitesimalQuadraticUni A B C D (EqUni p)) x) ∨ (evalUni (substInfinitesimalQuadraticUni A B C D (LessUni p)) x)" let ?b = "(∃y'>?r. ∀x∈{?r<..y'}. aEvalUni At x)" let ?c = "(evalUni (substInfinitesimalQuadraticUni A B C D At) x)" have t1: "?b = ?a" using z1 by auto have t2: "?a = ?c" using z4 using atis by auto then have "?b = ?c" using t1 t2 by auto then show "(∃y'>?r. ∀x∈{?r<..y'}. aEvalUni At x) = evalUni (substInfinitesimalQuadraticUni A B C D At) x" by auto qed then show ?thesis using LeqUni fields by blast qed next case (NeqUni p) then show ?thesis proof (cases p) case (fields a b c) then show ?thesis unfolding NeqUni fields using nonzcoeffs by auto qed qed end
subsection "Overall General VS Proofs" theory DNFUni imports QE InfinitesimalsUni begin fun DNFUni :: "atomUni fmUni ⇒ atomUni list list" where "DNFUni (AtomUni a) = [[a]]"| "DNFUni (TrueFUni) = [[]]" | "DNFUni (FalseFUni) = []"| "DNFUni (AndUni A B) = [A' @ B'. A' ← DNFUni A, B' ← DNFUni B]"| "DNFUni (OrUni A B) = DNFUni A @ DNFUni B" lemma eval_DNFUni : "evalUni F x = evalUni (list_disj_Uni(map (list_conj_Uni o (map AtomUni)) (DNFUni F))) x" proof(induction F) case TrueFUni then show ?case by auto next case FalseFUni then show ?case by auto next case (AtomUni x) then show ?case by auto next case (AndUni F1 F2) show ?case unfolding DNFUni.simps eval_list_disj_Uni evalUni.simps AndUni List.map_concat List.set_concat apply simp unfolding eval_list_conj_Uni_append by blast next case (OrUni F1 F2) then show ?case unfolding DNFUni.simps List.map_append eval_list_disj_Uni List.set_append evalUni.simps by blast qed fun elimVarUni_atom :: "atomUni list ⇒ atomUni ⇒ atomUni fmUni" where "elimVarUni_atom F (EqUni (a,b,c)) = (OrUni (AndUni (AndUni (AtomUni (EqUni (0,0,a))) (AtomUni (NeqUni (0,0,b)))) (list_conj_Uni (map (linearSubstitutionUni b c) F))) (AndUni (AtomUni (NeqUni (0,0,a))) (AndUni (AtomUni(LeqUni (0,0,-(b^2)+4*a*c))) (OrUni (list_conj_Uni (map (quadraticSubUni (-b) 1 (b^2-4*a*c) (2*a)) F)) (list_conj_Uni (map (quadraticSubUni (-b) (-1) (b^2-4*a*c) (2*a)) F)) ) ) ) ) " | "elimVarUni_atom F (LeqUni (a,b,c)) = (OrUni (AndUni (AndUni (AtomUni (EqUni (0,0,a))) (AtomUni (NeqUni (0,0,b)))) (list_conj_Uni (map (linearSubstitutionUni b c) F))) (AndUni (AtomUni (NeqUni (0,0,a))) (AndUni (AtomUni(LeqUni (0,0,-(b^2)+4*a*c))) (OrUni (list_conj_Uni (map (quadraticSubUni (-b) 1 (b^2-4*a*c) (2*a)) F)) (list_conj_Uni (map (quadraticSubUni (-b) (-1) (b^2-4*a*c) (2*a)) F)) ) ) ) ) " | "elimVarUni_atom F (LessUni (a,b,c)) = (OrUni (AndUni (AndUni (AtomUni (EqUni (0,0,a))) (AtomUni (NeqUni (0,0,b)))) (list_conj_Uni (map (substInfinitesimalLinearUni b c) F))) (AndUni (AtomUni (NeqUni (0,0,a))) (AndUni (AtomUni(LeqUni (0,0,-(b^2)+4*a*c))) (OrUni (list_conj_Uni (map(substInfinitesimalQuadraticUni (-b) 1 (b^2-4*a*c) (2*a)) F)) (list_conj_Uni (map(substInfinitesimalQuadraticUni (-b) (-1) (b^2-4*a*c) (2*a)) F)) ) ) ) ) "| "elimVarUni_atom F (NeqUni (a,b,c)) = (OrUni (AndUni (AndUni (AtomUni (EqUni (0,0,a))) (AtomUni (NeqUni (0,0,b)))) (list_conj_Uni (map (substInfinitesimalLinearUni b c) F))) (AndUni (AtomUni (NeqUni (0,0,a))) (AndUni (AtomUni(LeqUni (0,0,-(b^2)+4*a*c))) (OrUni (list_conj_Uni (map(substInfinitesimalQuadraticUni (-b) 1 (b^2-4*a*c) (2*a)) F)) (list_conj_Uni (map(substInfinitesimalQuadraticUni (-b) (-1) (b^2-4*a*c) (2*a)) F)) ) ) ) ) " fun generalVS_DNF :: "atomUni list ⇒ atomUni fmUni" where "generalVS_DNF L = list_disj_Uni (list_conj_Uni(map substNegInfinityUni L) # (map (λA. elimVarUni_atom L A) L))" end
theory GeneralVSProofs imports DNFUni EqualityVS VSAlgos begin fun separateAtoms :: "atomUni list ⇒ (real * real * real) list * (real * real * real) list * (real * real * real) list * (real * real * real) list" where "separateAtoms [] = ([],[],[],[])"| "separateAtoms (EqUni p # L) = (let (a,b,c,d) = separateAtoms(L) in (p#a,b,c,d))"| "separateAtoms (LessUni p # L) = (let (a,b,c,d) = separateAtoms(L) in (a,p#b,c,d))"| "separateAtoms (LeqUni p # L) = (let (a,b,c,d) = separateAtoms(L) in (a,b,p#c,d))"| "separateAtoms (NeqUni p # L) = (let (a,b,c,d) = separateAtoms(L) in (a,b,c,p#d))" lemma separate_aEval : assumes "separateAtoms L = (a,b,c,d)" shows "(∀l∈set L. aEvalUni l x) = ((∀(a,b,c)∈set a. a*x^2+b*x+c=0) ∧ (∀(a,b,c)∈set b. a*x^2+b*x+c<0) ∧ (∀(a,b,c)∈set c. a*x^2+b*x+c≤0) ∧ (∀(a,b,c)∈set d. a*x^2+b*x+c≠0))" using assms proof(induction L arbitrary :a b c d) case Nil then show ?case by auto next case (Cons At L) then have Cons1 : "⋀a b c d. separateAtoms L = (a, b, c, d) ⟹ (∀l∈set L. aEvalUni l x) = ((∀a∈set a. case a of (a, ba, c) ⇒ a * x⇧2 + ba * x + c = 0) ∧ (∀a∈set b. case a of (a, ba, c) ⇒ a * x⇧2 + ba * x + c < 0)∧ (∀a∈set c. case a of (a, ba, c) ⇒ a * x⇧2 + ba * x + c ≤ 0) ∧ (∀a∈set d. case a of (a, ba, c) ⇒ a * x⇧2 + ba * x + c ≠ 0))" " separateAtoms (At # L) = (a, b,c,d)" by auto then show ?case proof(cases At) case (LessUni p) show ?thesis proof(cases b) case Nil show ?thesis using Cons(2) unfolding LessUni separateAtoms.simps Nil apply(cases "separateAtoms L") by simp next case (Cons p' b') then have p_def : "p' = p" using Cons1(2) unfolding LessUni separateAtoms.simps apply(cases "separateAtoms L") by simp have h1 : "separateAtoms L = (a,b',c,d)" using Cons Cons1(2) unfolding LessUni separateAtoms.simps apply(cases "separateAtoms L") by simp have h2 : "(∀a∈set (p # b'). case a of (a, ba, c) ⇒ a * x⇧2 + ba * x + c < 0) = ( (∀a∈set (b'). case a of (a, ba, c) ⇒ a * x⇧2 + ba * x + c < 0)∧ (case p of (a, ba, c) ⇒ a * x⇧2 + ba * x + c < 0))" by auto have h3 : "(∀l∈set (LessUni p # L). aEvalUni l x) = ((∀l∈set (L). aEvalUni l x)∧(case p of (a, ba, c) ⇒ a * x⇧2 + ba * x + c < 0))" by auto show ?thesis unfolding Cons LessUni p_def h2 h3 using Cons1(1)[OF h1] by auto qed next case (EqUni p) show ?thesis proof(cases a) case Nil show ?thesis using Cons(2) unfolding EqUni separateAtoms.simps Nil apply(cases "separateAtoms L") by simp next case (Cons p' a') then have p_def : "p' = p" using Cons1(2) unfolding EqUni separateAtoms.simps apply(cases "separateAtoms L") by simp have h1 : "separateAtoms L = (a',b,c,d)" using Cons Cons1(2) unfolding EqUni separateAtoms.simps apply(cases "separateAtoms L") by simp have h2 : "(∀a∈set (p # a'). case a of (a, ba, c) ⇒ a * x⇧2 + ba * x + c = 0) = ( (∀a∈set (a'). case a of (a, ba, c) ⇒ a * x⇧2 + ba * x + c = 0)∧ (case p of (a, ba, c) ⇒ a * x⇧2 + ba * x + c = 0))" by auto have h3 : "(∀l∈set (EqUni p # L). aEvalUni l x) = ((∀l∈set (L). aEvalUni l x)∧(case p of (a, ba, c) ⇒ a * x⇧2 + ba * x + c = 0))" by auto show ?thesis unfolding Cons EqUni p_def h2 h3 using Cons1(1)[OF h1] by auto qed next case (LeqUni p) then show ?thesis proof(cases c) case Nil show ?thesis using Cons(2) unfolding LeqUni separateAtoms.simps Nil apply(cases "separateAtoms L") by simp next case (Cons p' a') then have p_def : "p' = p" using Cons1(2) unfolding LeqUni separateAtoms.simps apply(cases "separateAtoms L") by simp have h1 : "separateAtoms L = (a,b,a',d)" using Cons Cons1(2) unfolding LeqUni separateAtoms.simps apply(cases "separateAtoms L") by simp have h2 : "(∀a∈set (p # a'). case a of (a, ba, c) ⇒ a * x⇧2 + ba * x + c ≤ 0) = ( (∀a∈set (a'). case a of (a, ba, c) ⇒ a * x⇧2 + ba * x + c ≤ 0)∧ (case p of (a, ba, c) ⇒ a * x⇧2 + ba * x + c ≤ 0))" by auto have h3 : "(∀l∈set (LeqUni p # L). aEvalUni l x) = ((∀l∈set (L). aEvalUni l x)∧(case p of (a, ba, c) ⇒ a * x⇧2 + ba * x + c ≤ 0))" by auto show ?thesis unfolding Cons LeqUni p_def h2 h3 using Cons1(1)[OF h1] by auto qed next case (NeqUni p) then show ?thesis proof(cases d) case Nil show ?thesis using Cons(2) unfolding NeqUni separateAtoms.simps Nil apply(cases "separateAtoms L") by simp next case (Cons p' a') then have p_def : "p' = p" using Cons1(2) unfolding NeqUni separateAtoms.simps apply(cases "separateAtoms L") by simp have h1 : "separateAtoms L = (a,b,c,a')" using Cons Cons1(2) unfolding NeqUni separateAtoms.simps apply(cases "separateAtoms L") by simp have h2 : "(∀a∈set (p # a'). case a of (a, ba, c) ⇒ a * x⇧2 + ba * x + c ≠ 0) = ( (∀a∈set (a'). case a of (a, ba, c) ⇒ a * x⇧2 + ba * x + c ≠ 0)∧ (case p of (a, ba, c) ⇒ a * x⇧2 + ba * x + c ≠ 0))" by auto have h3 : "(∀l∈set (NeqUni p # L). aEvalUni l x) = ((∀l∈set (L). aEvalUni l x)∧(case p of (a, ba, c) ⇒ a * x⇧2 + ba * x + c ≠ 0))" by auto show ?thesis unfolding Cons NeqUni p_def h2 h3 using Cons1(1)[OF h1] by auto qed qed qed lemma splitAtoms_negInfinity : assumes "separateAtoms L = (a,b,c,d)" shows "(∀l∈set L. evalUni (substNegInfinityUni l) x) = ( (∀(a,b,c)∈set a.(∃x. ∀y<x. a*y^2+b*y+c=0))∧ (∀(a,b,c)∈set b.(∃x. ∀y<x. a*y^2+b*y+c<0))∧ (∀(a,b,c)∈set c.(∃x. ∀y<x. a*y^2+b*y+c≤0))∧ (∀(a,b,c)∈set d.(∃x. ∀y<x. a*y^2+b*y+c≠0)))" using assms proof(induction L arbitrary :a b c d) case Nil then show ?case by auto next case (Cons At L) then have Cons1 : "⋀a b c d. separateAtoms L = (a, b, c, d) ⟹ (∀l∈set L. evalUni (substNegInfinityUni l) x) = ((∀a∈set a. case a of (a, ba, c) ⇒ ∃x. ∀y<x. a * y⇧2 + ba * y + c = 0) ∧ (∀a∈set b. case a of (a, ba, c) ⇒ ∃x. ∀y<x. a * y⇧2 + ba * y + c < 0)∧ (∀a∈set c. case a of (a, ba, c) ⇒ ∃x. ∀y<x. a * y⇧2 + ba * y + c ≤ 0)∧ (∀a∈set d. case a of (a, ba, c) ⇒ ∃x. ∀y<x. a * y⇧2 + ba * y + c ≠ 0))" "separateAtoms (At # L) = (a, b, c, d)" by auto then show ?case proof(cases At) case (LessUni p) show ?thesis using LessUni Cons proof(induction b rule : list.induct) case Nil then have Nil : "b = []" using Cons.prems by auto show ?case using Cons(2) unfolding LessUni separateAtoms.simps Nil apply(cases "separateAtoms L") by simp next case (Cons p' b') then have p_def : "p' = p" using Cons1(2) unfolding LessUni separateAtoms.simps apply(cases "separateAtoms L") by simp have h1 : "separateAtoms L = (a,b',c,d)" using Cons Cons1(2) unfolding LessUni separateAtoms.simps apply(cases "separateAtoms L") by simp have h2 : "(∀a∈set (p # b'). case a of (a, ba, c) ⇒ ∃x. ∀y<x. a * y⇧2 + ba * y + c < 0) = ( (∀a∈set ( b'). case a of (a, ba, c) ⇒ ∃x. ∀y<x. a * y⇧2 + ba * y + c < 0)∧ (case p of (a, ba, c) ⇒ ∃x. ∀y<x. a * y⇧2 + ba * y + c < 0))" by auto have one: "(∃x. ∀y<x. aEvalUni (LessUni p) y) = (case p of (a, ba, c) ⇒ ∃x. ∀y<x. a * y⇧2 + ba * y + c < 0)" apply(cases p) by simp have "(∀l∈set (LessUni p # L). evalUni (substNegInfinityUni l) x) = ((evalUni (substNegInfinityUni (LessUni p)) x)∧(∀l∈set ( L). evalUni (substNegInfinityUni l) x))" by auto also have "... = ( (case p of (a,ba,c) ⇒ ∃x. ∀y<x. a * y⇧2 + ba * y + c < 0)∧ (∀a∈set a. case a of (a, ba, c) ⇒ ∃x. ∀y<x. a * y⇧2 + ba * y + c = 0) ∧ (∀a∈set b'. case a of (a, ba, c) ⇒ ∃x. ∀y<x. a * y⇧2 + ba * y + c < 0)∧ (∀a∈set c. case a of (a, ba, c) ⇒ ∃x. ∀y<x. a * y⇧2 + ba * y + c ≤ 0)∧ (∀a∈set d. case a of (a, ba, c) ⇒ ∃x. ∀y<x. a * y⇧2 + ba * y + c ≠ 0))" unfolding infinity_evalUni[of "LessUni p" x, symmetric] Cons(3)[OF h1] LessUni one by simp finally have h3 : "(∀l∈set (LessUni p # L). evalUni (substNegInfinityUni l) x) = ( (case p of (a,ba,c) ⇒ ∃x. ∀y<x. a * y⇧2 + ba * y + c < 0)∧ (∀a∈set a. case a of (a, ba, c) ⇒ ∃x. ∀y<x. a * y⇧2 + ba * y + c = 0) ∧ (∀a∈set b'. case a of (a, ba, c) ⇒ ∃x. ∀y<x. a * y⇧2 + ba * y + c < 0)∧ (∀a∈set c. case a of (a, ba, c) ⇒ ∃x. ∀y<x. a * y⇧2 + ba * y + c ≤ 0)∧ (∀a∈set d. case a of (a, ba, c) ⇒ ∃x. ∀y<x. a * y⇧2 + ba * y + c ≠ 0) )" by auto show ?case unfolding Cons LessUni p_def h2 h3 using Cons1(1)[OF h1] by auto qed next case (EqUni p) show ?thesis using EqUni Cons proof(induction a rule : list.induct) case Nil then have Nil : "a = []" using Cons.prems by auto show ?case using Cons(2) unfolding EqUni separateAtoms.simps Nil apply(cases "separateAtoms L") by simp next case (Cons p' a') then have p_def : "p' = p" using Cons1(2) unfolding EqUni separateAtoms.simps apply(cases "separateAtoms L") by simp have h1 : "separateAtoms L = (a',b,c,d)" using Cons Cons1(2) unfolding EqUni separateAtoms.simps apply(cases "separateAtoms L") by simp have h2 : "(∀a∈set (p # a'). case a of (a, ba, c) ⇒ ∃x. ∀y<x. a * y⇧2 + ba * y + c = 0) = ( (∀a∈set ( a'). case a of (a, ba, c) ⇒ ∃x. ∀y<x. a * y⇧2 + ba * y + c = 0)∧ (case p of (a, ba, c) ⇒ ∃x. ∀y<x. a * y⇧2 + ba * y + c = 0))" by auto have one: "(∃x. ∀y<x. aEvalUni (EqUni p) y) = (case p of (a, ba, c) ⇒ ∃x. ∀y<x. a * y⇧2 + ba * y + c = 0)" apply(cases p) by simp have "(∀l∈set (EqUni p # L). evalUni (substNegInfinityUni l) x) = ((evalUni (substNegInfinityUni (EqUni p)) x)∧(∀l∈set ( L). evalUni (substNegInfinityUni l) x))" by auto also have "... = ( (case p of (a,ba,c) ⇒ ∃x. ∀y<x. a * y⇧2 + ba * y + c = 0)∧ (∀a∈set a'. case a of (a, ba, c) ⇒ ∃x. ∀y<x. a * y⇧2 + ba * y + c = 0) ∧ (∀a∈set b. case a of (a, ba, c) ⇒ ∃x. ∀y<x. a * y⇧2 + ba * y + c < 0)∧ (∀a∈set c. case a of (a, ba, c) ⇒ ∃x. ∀y<x. a * y⇧2 + ba * y + c ≤ 0)∧ (∀a∈set d. case a of (a, ba, c) ⇒ ∃x. ∀y<x. a * y⇧2 + ba * y + c ≠ 0))" unfolding infinity_evalUni[of "EqUni p" x, symmetric] Cons(3)[OF h1] EqUni one by simp finally have h3 : "(∀l∈set (EqUni p # L). evalUni (substNegInfinityUni l) x) = ( (case p of (a,ba,c) ⇒ ∃x. ∀y<x. a * y⇧2 + ba * y + c = 0)∧ (∀a∈set a'. case a of (a, ba, c) ⇒ ∃x. ∀y<x. a * y⇧2 + ba * y + c = 0) ∧ (∀a∈set b. case a of (a, ba, c) ⇒ ∃x. ∀y<x. a * y⇧2 + ba * y + c < 0)∧ (∀a∈set c. case a of (a, ba, c) ⇒ ∃x. ∀y<x. a * y⇧2 + ba * y + c ≤ 0)∧ (∀a∈set d. case a of (a, ba, c) ⇒ ∃x. ∀y<x. a * y⇧2 + ba * y + c ≠ 0))" by auto show ?case unfolding Cons EqUni p_def h2 h3 using Cons1(1)[OF h1] by auto qed next case (LeqUni p) show ?thesis using LeqUni Cons proof(induction c rule : list.induct) case Nil then have Nil : "c = []" using Cons.prems by auto show ?case using Cons(2) unfolding LeqUni separateAtoms.simps Nil apply(cases "separateAtoms L") by simp next case (Cons p' c') then have p_def : "p' = p" using Cons1(2) unfolding LeqUni separateAtoms.simps apply(cases "separateAtoms L") by simp have h1 : "separateAtoms L = (a,b,c',d)" using Cons Cons1(2) unfolding LeqUni separateAtoms.simps apply(cases "separateAtoms L") by simp have h2 : "(∀a∈set (p # c'). case a of (a, ba, c) ⇒ ∃x. ∀y<x. a * y⇧2 + ba * y + c ≤ 0) = ( (∀a∈set ( c'). case a of (a, ba, c) ⇒ ∃x. ∀y<x. a * y⇧2 + ba * y + c ≤ 0)∧ (case p of (a, ba, c) ⇒ ∃x. ∀y<x. a * y⇧2 + ba * y + c ≤ 0))" by auto have one: "(∃x. ∀y<x. aEvalUni (LeqUni p) y) = (case p of (a, ba, c) ⇒ ∃x. ∀y<x. a * y⇧2 + ba * y + c ≤ 0)" apply(cases p) by simp have "(∀l∈set (LeqUni p # L). evalUni (substNegInfinityUni l) x) = ((evalUni (substNegInfinityUni (LeqUni p)) x)∧(∀l∈set ( L). evalUni (substNegInfinityUni l) x))" by auto also have "... = ( (case p of (a,ba,c) ⇒ ∃x. ∀y<x. a * y⇧2 + ba * y + c ≤ 0)∧ (∀a∈set a. case a of (a, ba, c) ⇒ ∃x. ∀y<x. a * y⇧2 + ba * y + c = 0) ∧ (∀a∈set b. case a of (a, ba, c) ⇒ ∃x. ∀y<x. a * y⇧2 + ba * y + c < 0)∧ (∀a∈set c'. case a of (a, ba, c) ⇒ ∃x. ∀y<x. a * y⇧2 + ba * y + c ≤ 0)∧ (∀a∈set d. case a of (a, ba, c) ⇒ ∃x. ∀y<x. a * y⇧2 + ba * y + c ≠ 0))" unfolding infinity_evalUni[of "LeqUni p" x, symmetric] Cons(3)[OF h1] LeqUni one by simp finally have h3 : "(∀l∈set (LeqUni p # L). evalUni (substNegInfinityUni l) x) = ( (case p of (a,ba,c) ⇒ ∃x. ∀y<x. a * y⇧2 + ba * y + c ≤ 0)∧ (∀a∈set a. case a of (a, ba, c) ⇒ ∃x. ∀y<x. a * y⇧2 + ba * y + c = 0) ∧ (∀a∈set b. case a of (a, ba, c) ⇒ ∃x. ∀y<x. a * y⇧2 + ba * y + c < 0)∧ (∀a∈set c'. case a of (a, ba, c) ⇒ ∃x. ∀y<x. a * y⇧2 + ba * y + c ≤ 0)∧ (∀a∈set d. case a of (a, ba, c) ⇒ ∃x. ∀y<x. a * y⇧2 + ba * y + c ≠ 0) )" by auto show ?case unfolding Cons LeqUni p_def h2 h3 using Cons1(1)[OF h1] by auto qed next case (NeqUni p) show ?thesis using NeqUni Cons proof(induction d rule : list.induct) case Nil then have Nil : "d = []" using Cons.prems by auto show ?case using Cons(2) unfolding NeqUni separateAtoms.simps Nil apply(cases "separateAtoms L") by simp next case (Cons p' d') then have p_def : "p' = p" using Cons1(2) unfolding NeqUni separateAtoms.simps apply(cases "separateAtoms L") by simp have h1 : "separateAtoms L = (a,b,c,d')" using Cons Cons1(2) unfolding NeqUni separateAtoms.simps apply(cases "separateAtoms L") by simp have h2 : "(∀a∈set (p # d'). case a of (a, ba, c) ⇒ ∃x. ∀y<x. a * y⇧2 + ba * y + c ≠ 0) = ( (∀a∈set ( d'). case a of (a, ba, c) ⇒ ∃x. ∀y<x. a * y⇧2 + ba * y + c ≠ 0)∧ (case p of (a, ba, c) ⇒ ∃x. ∀y<x. a * y⇧2 + ba * y + c ≠ 0))" by auto have one: "(∃x. ∀y<x. aEvalUni (NeqUni p) y) = (case p of (a, ba, c) ⇒ ∃x. ∀y<x. a * y⇧2 + ba * y + c ≠ 0)" apply(cases p) by simp have "(∀l∈set (NeqUni p # L). evalUni (substNegInfinityUni l) x) = ((evalUni (substNegInfinityUni (NeqUni p)) x)∧(∀l∈set ( L). evalUni (substNegInfinityUni l) x))" by auto also have "... = ( (case p of (a,ba,c) ⇒ ∃x. ∀y<x. a * y⇧2 + ba * y + c ≠ 0)∧ (∀a∈set a. case a of (a, ba, c) ⇒ ∃x. ∀y<x. a * y⇧2 + ba * y + c = 0) ∧ (∀a∈set b. case a of (a, ba, c) ⇒ ∃x. ∀y<x. a * y⇧2 + ba * y + c < 0)∧ (∀a∈set c. case a of (a, ba, c) ⇒ ∃x. ∀y<x. a * y⇧2 + ba * y + c ≤ 0)∧ (∀a∈set d'. case a of (a, ba, c) ⇒ ∃x. ∀y<x. a * y⇧2 + ba * y + c ≠ 0))" unfolding infinity_evalUni[of "NeqUni p" x, symmetric] Cons(3)[OF h1] NeqUni one by simp finally have h3 : "(∀l∈set (NeqUni p # L). evalUni (substNegInfinityUni l) x) = ( (case p of (a,ba,c) ⇒ ∃x. ∀y<x. a * y⇧2 + ba * y + c ≠ 0)∧ (∀a∈set a. case a of (a, ba, c) ⇒ ∃x. ∀y<x. a * y⇧2 + ba * y + c = 0) ∧ (∀a∈set b. case a of (a, ba, c) ⇒ ∃x. ∀y<x. a * y⇧2 + ba * y + c < 0)∧ (∀a∈set c. case a of (a, ba, c) ⇒ ∃x. ∀y<x. a * y⇧2 + ba * y + c ≤ 0)∧ (∀a∈set d'. case a of (a, ba, c) ⇒ ∃x. ∀y<x. a * y⇧2 + ba * y + c ≠ 0) )" by auto show ?case unfolding Cons NeqUni p_def h2 h3 using Cons1(1)[OF h1] by auto qed qed qed lemma set_split : assumes "separateAtoms L = (eq,les,leq,neq)" shows "set L = set (map EqUni eq @ map LessUni les @ map LeqUni leq @ map NeqUni neq)" using assms proof(induction L arbitrary :eq les leq neq) case Nil then show ?case by auto next case (Cons At L) then show ?case proof(cases At) case (LessUni p) have "∃les'. p#les' = les ∧ separateAtoms L = (eq, les', leq, neq)" using Cons(2) unfolding LessUni apply (cases "separateAtoms L") by auto then obtain les' where les' : "p#les' = les" "separateAtoms L = (eq, les', leq, neq)" by auto show ?thesis unfolding LessUni les'(1)[symmetric] using Cons(1)[OF les'(2)] by auto next case (EqUni p) have "∃eq'. p#eq' = eq ∧ separateAtoms L = (eq', les, leq, neq)" using Cons(2) unfolding EqUni apply (cases "separateAtoms L") by auto then obtain eq' where eq' : "p#eq' = eq" "separateAtoms L = (eq', les, leq, neq)" by auto show ?thesis unfolding EqUni eq'(1)[symmetric] using Cons(1)[OF eq'(2)] by auto next case (LeqUni p) have "∃leq'. p#leq' = leq ∧ separateAtoms L = (eq, les, leq', neq)" using Cons(2) unfolding LeqUni apply (cases "separateAtoms L") by auto then obtain leq' where leq' : "p#leq' = leq" "separateAtoms L = (eq, les, leq', neq)" by auto show ?thesis unfolding LeqUni leq'(1)[symmetric] using Cons(1)[OF leq'(2)] by auto next case (NeqUni p) have "∃neq'. p#neq' = neq ∧ separateAtoms L = (eq, les, leq, neq')" using Cons(2) unfolding NeqUni apply (cases "separateAtoms L") by auto then obtain neq' where neq' : "p#neq' = neq" "separateAtoms L = (eq, les, leq, neq')" by auto show ?thesis unfolding NeqUni neq'(1)[symmetric] using Cons(1)[OF neq'(2)] by auto qed qed lemma set_split' : assumes "separateAtoms L = (eq,les,leq,neq)" shows "set (map P L) = set (map (P o EqUni) eq @ map (P o LessUni) les @ map (P o LeqUni) leq @ map (P o NeqUni) neq)" unfolding image_set[symmetric] set_split[OF assms] unfolding image_set map_append map_map by auto lemma split_elimVar : assumes "separateAtoms L = (eq,les,leq,neq)" shows "(∃l∈set L. evalUni (elimVarUni_atom L' l) x) = ((∃(a',b',c')∈set eq. (evalUni (elimVarUni_atom L' (EqUni(a',b',c'))) x)) ∨ (∃(a',b',c')∈set les. (evalUni (elimVarUni_atom L' (LessUni(a',b',c'))) x)) ∨ (∃(a',b',c')∈set leq. (evalUni (elimVarUni_atom L' (LeqUni(a',b',c'))) x)) ∨ (∃(a',b',c')∈set neq. (evalUni (elimVarUni_atom L' (NeqUni(a',b',c'))) x)))" proof- have c1: "(∃l∈set eq. evalUni (elimVarUni_atom L' (EqUni l)) x) = (∃(a', b', c')∈set eq. evalUni (elimVarUni_atom L' (EqUni (a', b', c'))) x)" by (metis (no_types, lifting) case_prodE case_prodI2) have c2: "(∃l∈set les. evalUni (elimVarUni_atom L' (LessUni l)) x) = (∃(a', b', c')∈set les. evalUni (elimVarUni_atom L' (LessUni (a', b', c'))) x)" by (metis (no_types, lifting) case_prodE case_prodI2) have c3: "(∃l∈set leq. evalUni (elimVarUni_atom L' (LeqUni l)) x) = (∃(a', b', c')∈set leq. evalUni (elimVarUni_atom L' (LeqUni (a', b', c'))) x)" by (metis (no_types, lifting) case_prodE case_prodI2) have c4: "(∃l∈set neq. evalUni (elimVarUni_atom L' (NeqUni l)) x) = (∃(a', b', c')∈set neq. evalUni (elimVarUni_atom L' (NeqUni (a', b', c'))) x)" by (metis (no_types, lifting) case_prodE case_prodI2) have h : "((∃l∈EqUni ` set eq. evalUni (elimVarUni_atom L' l) x) ∨ (∃l∈LessUni ` set les. evalUni (elimVarUni_atom L' l) x) ∨ (∃l∈LeqUni ` set leq. evalUni (elimVarUni_atom L' l) x) ∨ (∃l∈NeqUni ` set neq. evalUni (elimVarUni_atom L' l) x) ) = ((∃l∈set eq. evalUni (elimVarUni_atom L' (EqUni l)) x) ∨ (∃l∈set les. evalUni (elimVarUni_atom L' (LessUni l)) x) ∨ (∃l∈set leq. evalUni (elimVarUni_atom L' (LeqUni l)) x) ∨ (∃l∈set neq. evalUni (elimVarUni_atom L' (NeqUni l)) x) )" by auto then have "... = ((∃(a', b', c')∈set eq. evalUni (elimVarUni_atom L' (EqUni (a', b', c'))) x) ∨ (∃(a', b', c')∈set les. evalUni (elimVarUni_atom L' (LessUni (a', b', c'))) x) ∨ (∃(a', b', c')∈set leq. evalUni (elimVarUni_atom L' (LeqUni (a', b', c'))) x) ∨ (∃(a', b', c')∈set neq. evalUni (elimVarUni_atom L' (NeqUni (a', b', c'))) x))" using c1 c2 c3 c4 by auto then show ?thesis unfolding set_split[OF assms] set_append bex_Un image_set[symmetric] using case_prodE case_prodI2 by auto qed lemma split_elimvar : assumes "separateAtoms L = (eq,les,leq,neq)" shows "evalUni (elimVarUni_atom L At) x = evalUni (elimVarUni_atom ((map EqUni eq)@(map LessUni les) @ map LeqUni leq @ map NeqUni neq) At) x" proof(cases At) case (LessUni p) then show ?thesis apply(cases p) apply simp unfolding eval_list_conj_Uni set_split'[OF assms] by simp next case (EqUni p) then show ?thesis apply(cases p) apply simp unfolding eval_list_conj_Uni set_split'[OF assms] by simp next case (LeqUni p) then show ?thesis apply(cases p) apply simp unfolding eval_list_conj_Uni set_split'[OF assms] by simp next case (NeqUni p) then show ?thesis apply(cases p) apply simp unfolding eval_list_conj_Uni set_split'[OF assms] by simp qed lemma less : " ((a' = 0 ∧ b' ≠ 0) ∧ (∀(d, e, f)∈set a. evalUni (substInfinitesimalLinearUni b' c' (EqUni (d, e, f))) x) ∧ (∀(d, e, f)∈set b. evalUni (substInfinitesimalLinearUni b' c' (LessUni (d, e, f))) x) ∧ (∀(d, e, f)∈set c. evalUni (substInfinitesimalLinearUni b' c' (LeqUni (d, e, f))) x) ∧ (∀(d, e, f)∈set d. evalUni (substInfinitesimalLinearUni b' c' (NeqUni (d, e, f))) x) ∨ a' ≠ 0 ∧ - b'⇧2 + 4 * a' * c' ≤ 0 ∧ ((∀(d, e, f)∈set a. evalUni (substInfinitesimalQuadraticUni (- b') 1 (b'⇧2 - 4 * a' * c') (2 * a') (EqUni (d, e, f))) x) ∧ (∀(d, e, f)∈set b. evalUni (substInfinitesimalQuadraticUni (- b') 1 (b'⇧2 - 4 * a' * c') (2 * a') (LessUni (d, e, f))) x) ∧ (∀(d, e, f)∈set c. evalUni (substInfinitesimalQuadraticUni (- b') 1 (b'⇧2 - 4 * a' * c') (2 * a') (LeqUni (d, e, f))) x) ∧ (∀(d, e, f)∈set d. evalUni (substInfinitesimalQuadraticUni (- b') 1 (b'⇧2 - 4 * a' * c') (2 * a') (NeqUni (d, e, f))) x) ∨ (∀(d, e, f)∈set a. evalUni (substInfinitesimalQuadraticUni (- b') (- 1) (b'⇧2 - 4 * a' * c') (2 * a') (EqUni (d, e, f))) x) ∧ (∀(d, e, f)∈set b. evalUni (substInfinitesimalQuadraticUni (- b') (- 1) (b'⇧2 - 4 * a' * c') (2 * a') (LessUni (d, e, f))) x) ∧ (∀(d, e, f)∈set c. evalUni (substInfinitesimalQuadraticUni (- b') (- 1) (b'⇧2 - 4 * a' * c') (2 * a') (LeqUni (d, e, f))) x) ∧ (∀(d, e, f)∈set d. evalUni (substInfinitesimalQuadraticUni (- b') (- 1) (b'⇧2 - 4 * a' * c') (2 * a') (NeqUni (d, e, f))) x))) = ((a' = 0 ∧ b' ≠ 0) ∧ (∀(d, e, f)∈set a. (∃y'::real>-c'/b'. ∀x::real ∈{-c'/b'<..y'}. aEvalUni (EqUni (d, e, f)) x)) ∧ (∀(d, e, f)∈set b. (∃y'::real>-c'/b'. ∀x::real ∈{-c'/b'<..y'}. aEvalUni (LessUni (d, e, f)) x))∧ (∀(d, e, f)∈set c. (∃y'::real>-c'/b'. ∀x::real ∈{-c'/b'<..y'}. aEvalUni (LeqUni (d, e, f)) x)) ∧ (∀(d, e, f)∈set d. (∃y'::real>-c'/b'. ∀x::real ∈{-c'/b'<..y'}. aEvalUni (NeqUni (d, e, f)) x)) ∨ a' ≠ 0 ∧ - b'⇧2 + 4 * a' * c' ≤ 0 ∧ ((∀(d, e, f)∈set a. (∃y'>(- b' + 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a'). ∀x∈{(- b' + 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a')<..y'}. aEvalUni (EqUni (d,e,f)) x)) ∧ (∀(d, e, f)∈set b. (∃y'>(- b' + 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a'). ∀x∈{(- b' + 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a')<..y'}. aEvalUni (LessUni (d,e,f)) x)) ∧ (∀(d, e, f)∈set c. (∃y'>(- b' + 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a'). ∀x∈{(- b' + 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a')<..y'}. aEvalUni (LeqUni (d,e,f)) x)) ∧ (∀(d, e, f)∈set d. (∃y'>(- b' + 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a'). ∀x∈{(- b' + 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a')<..y'}. aEvalUni (NeqUni (d,e,f)) x)) ∨ (∀(d, e, f)∈set a. (∃y'>(- b' + - 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a'). ∀x∈{(- b' + - 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a')<..y'}. aEvalUni (EqUni (d,e,f)) x)) ∧ (∀(d, e, f)∈set b. (∃y'>(- b' + - 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a'). ∀x∈{(- b' + - 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a')<..y'}. aEvalUni (LessUni (d,e,f)) x)) ∧ (∀(d, e, f)∈set c. (∃y'>(- b' + - 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a'). ∀x∈{(- b' + - 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a')<..y'}. aEvalUni (LeqUni (d,e,f)) x)) ∧ (∀(d, e, f)∈set d. (∃y'>(- b' + - 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a'). ∀x∈{(- b' + - 1 * sqrt (b'⇧2 - 4 * a' * c')) / (2 * a')<..y'}. aEvalUni (NeqUni (d,e,f)) x))))" proof(cases "a'=0") case True then have a' : "a'=0" by auto then show ?thesis proof(cases "b'=0") case True then show ?thesis using a' by auto next case False then show ?thesis using True unfolding infinitesimal_linear'[of b' c' _ x, symmetric, OF False] by auto qed next case False then have a' : "a' ≠ 0" by auto then have d : "2 * a' ≠ 0" by auto show ?thesis proof(cases "0 ≤ b'⇧2 - 4 * a' * c'") case True then show ?thesis using False unfolding infinitesimal_quad[OF d True, of "-b'", symmetric] by auto next case False then show ?thesis using a' by auto qed qed lemma eq_inf : "(∀(a, b, c)∈set (a::(real*real*real) list). ∃x. ∀y<x. a * y⇧2 + b * y + c = 0) = (∀(a, b, c)∈set a. a=0∧b=0∧c=0)" using infinity_evalUni_EqUni[of _ x] by auto text "This is the main quantifier elimination lemma, in the simplified framework. We are located directly underneath the most internal existential quantifier so F is completely free in quantifier and consists only of conjunction and disjunction. The variable we are evaluating on, x, is removed in the generalVS\\_DNF converted formula as expanding out the evalUni function determines that x doesn't play a role in the computation of it. It would be okay to replace the x in the second half with any variable, but it is simplier this way This conversion is defined as a \"veritcal\" translation as we remain within the univariate framework in both sides of the expression" lemma eval_generalVS'' : "(∃x. evalUni (list_conj_Uni (map AtomUni L)) x) = evalUni (generalVS_DNF L) x" proof(cases "separateAtoms L") case (fields a b c d) have a : "⋀ P. (∀l∈set (map EqUni a) ∪ (set (map LessUni b) ∪ (set (map LeqUni c) ∪ set (map NeqUni d))).P l) = ((∀(d,e,f)∈set a. P (EqUni (d,e,f))) ∧ (∀(d,e,f)∈set b. P (LessUni (d,e,f))) ∧ (∀(d,e,f)∈set c. P (LeqUni (d,e,f))) ∧ (∀(d,e,f)∈set d. P (NeqUni (d,e,f))))" by auto show ?thesis apply(simp add: eval_list_conj_Uni separate_aEval[OF fields] splitAtoms_negInfinity[OF fields] eval_list_disj_Uni del:elimVar.simps) unfolding eval_conj_atom generalVS_DNF.simps split_elimVar[OF fields ] split_elimvar[OF fields] unfolding elimVarUni_atom.simps evalUni.simps aEvalUni.simps Rings.mult_zero_class.mult_zero_left Groups.add_0 eval_list_conj_Uni Groups.group_add_class.minus_zero eval_map_all linearSubstitutionUni.simps quadraticSubUni.simps evalUni_if aEvalUni.simps set_append a less eq_inf using qe by auto qed lemma forallx_substNegInf : "(¬evalUni (map_atomUni substNegInfinityUni F) x) = (∀x. ¬ evalUni (map_atomUni substNegInfinityUni F) x)" proof(induction F) case TrueFUni then show ?case by simp next case FalseFUni then show ?case by simp next case (AtomUni At) then show ?case apply(cases At) by auto next case (AndUni F1 F2) then show ?case by auto next case (OrUni F1 F2) then show ?case by auto qed lemma linear_subst_map: "evalUni (map_atomUni (linearSubstitutionUni b c) F) x = evalUni F (-c/b)" apply(induction F)by auto lemma quadratic_subst_map : "evalUni (map_atomUni (quadraticSubUni a b c d) F) x = evalUni F ((a+b*sqrt(c))/d)" apply(induction F)by auto fun convert_atom_list :: "nat ⇒ atom list ⇒ real list ⇒ (atomUni list) option" where "convert_atom_list var [] xs = Some []"| "convert_atom_list var (a#as) xs = ( case convert_atom var a xs of Some(a) ⇒ (case convert_atom_list var as xs of Some(as) ⇒ Some(a#as) | None ⇒ None) | None ⇒ None )" lemma convert_atom_list_change : assumes "length xs' = var" shows "convert_atom_list var L (xs' @ x # Γ) = convert_atom_list var L (xs' @ x' # Γ)" apply(induction L)using convert_atom_change[OF assms] apply simp_all by (metis) lemma negInf_convert : assumes "convert_atom_list var L (xs' @ x # xs) = Some L'" assumes "length xs' = var" shows "(∀f∈set L. eval (substNegInfinity var f) (xs' @ x # xs)) = (∀f∈set L'. evalUni (substNegInfinityUni f) x)" using assms proof(induction L arbitrary : L') case Nil then show ?case by auto next case (Cons a L) then show ?case proof(cases a) case (Less p) have h: "MPoly_Type.degree p var < 3 ⟹ eval (substNegInfinity var (Less p)) (xs' @ x # xs) = evalUni (substNegInfinityUni (LessUni (insertion (nth_default 0 (xs' @ x # xs)) (isolate_variable_sparse p var 2), insertion (nth_default 0 (xs' @ x # xs)) (isolate_variable_sparse p var (Suc 0)), insertion (nth_default 0 (xs' @ x # xs)) (isolate_variable_sparse p var 0)))) x" using convert_substNegInfinity[of var "Less p" xs' x xs, OF _ assms(2)] by simp show ?thesis using Cons(2)[symmetric] Cons(1) unfolding Less apply(cases " MPoly_Type.degree p var < 3") defer apply simp apply(cases "convert_atom_list var L (xs' @ x # xs)") apply (simp_all del: substNegInfinity.simps substNegInfinityUni.simps) unfolding h using assms(2) by presburger next case (Eq p) have h: "MPoly_Type.degree p var < 3 ⟹ eval (substNegInfinity var (Eq p)) (xs' @ x # xs) = evalUni (substNegInfinityUni (EqUni (insertion (nth_default 0 (xs' @ x # xs)) (isolate_variable_sparse p var 2), insertion (nth_default 0 (xs' @ x # xs)) (isolate_variable_sparse p var (Suc 0)), insertion (nth_default 0 (xs' @ x # xs)) (isolate_variable_sparse p var 0)))) x" using convert_substNegInfinity[of var "Eq p", OF _ assms(2)] by simp show ?thesis using Cons(2)[symmetric] Cons(1) unfolding Eq apply(cases " MPoly_Type.degree p var < 3") defer apply simp apply(cases "convert_atom_list var L (xs' @ x # xs)") apply (simp_all del: substNegInfinity.simps substNegInfinityUni.simps) unfolding h assms by auto next case (Leq p) have h: "MPoly_Type.degree p var < 3 ⟹ eval (substNegInfinity var (Leq p)) (xs' @ x # xs) = evalUni (substNegInfinityUni (LeqUni (insertion (nth_default 0 (xs' @ x # xs)) (isolate_variable_sparse p var 2), insertion (nth_default 0 (xs' @ x # xs)) (isolate_variable_sparse p var (Suc 0)), insertion (nth_default 0 (xs' @ x # xs)) (isolate_variable_sparse p var 0)))) x" using convert_substNegInfinity[of var "Leq p", OF _ assms(2)] by simp show ?thesis using Cons(2) unfolding Leq apply(cases " MPoly_Type.degree p var < 3") defer apply simp apply(cases "convert_atom_list var L (xs' @ x # xs)") apply (simp_all del: substNegInfinity.simps substNegInfinityUni.simps) unfolding h using Cons.IH assms by auto next case (Neq p) have h: "MPoly_Type.degree p var < 3 ⟹ eval (substNegInfinity var (Neq p)) (xs' @ x # xs) = evalUni (substNegInfinityUni (NeqUni (insertion (nth_default 0 (xs' @ x # xs)) (isolate_variable_sparse p var 2), insertion (nth_default 0 (xs' @ x # xs)) (isolate_variable_sparse p var (Suc 0)), insertion (nth_default 0 (xs' @ x # xs)) (isolate_variable_sparse p var 0)))) x" using convert_substNegInfinity[of var "Neq p", OF _ assms(2)] by simp show ?thesis using Cons(2) unfolding Neq apply(cases " MPoly_Type.degree p var < 3") defer apply simp apply(cases "convert_atom_list var L (xs' @ x # xs)") apply (simp_all del: substNegInfinity.simps substNegInfinityUni.simps) unfolding h using Cons.IH assms by auto qed qed lemma elimVar_atom_single : assumes "convert_atom var A (xs' @ x # xs) = Some A'" assumes "convert_atom_list var L2 (xs' @ x # xs) = Some L2'" assumes "length xs' = var" shows "eval (elimVar var L2 [] A) (xs' @ x # xs) = evalUni (elimVarUni_atom L2' A') x" proof(cases A) case (Less p) define a where "a = insertion (nth_default 0 (xs' @ x # xs)) (isolate_variable_sparse p var 2)" have a_def' : "a = insertion (nth_default 0 (xs' @ 0 # xs)) (isolate_variable_sparse p var 2)" unfolding a_def using insertion_isovarspars_free[of "(xs' @ x # xs)" var x p 2 0] assms by auto define b where "b = insertion (nth_default 0 (xs' @ x # xs)) (isolate_variable_sparse p var (Suc 0))" have b_def' : "b = insertion (nth_default 0 (xs' @ 0 # xs)) (isolate_variable_sparse p var (Suc 0))" unfolding b_def using insertion_isovarspars_free[of "(xs' @ x # xs)" var x p "(Suc 0)" 0] assms by auto define c where "c = insertion (nth_default 0 (xs' @ x # xs)) (isolate_variable_sparse p var 0)" have c_def' : "c = insertion (nth_default 0 (xs' @ 0 # xs)) (isolate_variable_sparse p var 0)" unfolding c_def using insertion_isovarspars_free[of "(xs' @ x # xs)" var x p 0 0] assms by auto have linear : "b≠0 ⟹ (∀f∈set L2. eval (substInfinitesimalLinear var (-isolate_variable_sparse p var 0) (isolate_variable_sparse p var (Suc 0)) f) (xs' @ x # xs)) = (∀l∈set L2'. evalUni (substInfinitesimalLinearUni b c l) x)" using assms(2) proof(induction L2 arbitrary : L2') case Nil then show ?case by auto next case (Cons At L2) have "∃At'. convert_atom var At (xs' @ x # xs) = Some At'" proof(cases At) case (Less p) then show ?thesis using Cons(3) apply simp apply(cases "MPoly_Type.degree p var < 3") by simp_all next case (Eq p) then show ?thesis using Cons(3) apply simp apply(cases "MPoly_Type.degree p var < 3") by simp_all next case (Leq p) then show ?thesis using Cons(3) apply simp apply(cases "MPoly_Type.degree p var < 3") by auto next case (Neq p) then show ?thesis using Cons(3) apply simp apply(cases "MPoly_Type.degree p var < 3") by auto qed then obtain At' where At' : "convert_atom var At (xs' @ x # xs) = Some At'" by auto have "∃L2's. convert_atom_list var L2 (xs' @ x # xs) = Some L2's" using Cons(3) At' apply(cases "convert_atom_list var L2 (xs' @ x # xs)") by auto then obtain L2's where L2's : "convert_atom_list var L2 (xs' @ x # xs) = Some L2's" by auto have L2' : "L2' = At' # L2's" using Cons(3) At' by (simp_all add: L2's) have h : "eval (substInfinitesimalLinear var (-isolate_variable_sparse p var 0) (isolate_variable_sparse p var (Suc 0)) At) (xs' @ x # xs) = evalUni (substInfinitesimalLinearUni b c At') x" proof(cases "convert_atom var At (xs' @ x # xs)") case None then show ?thesis using At' apply(cases At) by simp_all next case (Some a) have h1 : "var ∉ vars (isolate_variable_sparse p var (Suc 0))" by (simp add: not_in_isovarspar) have h2 : "var ∉ vars (isolate_variable_sparse p var 0)"by (simp add: not_in_isovarspar) have h : "evalUni (substInfinitesimalLinearUni b c a) x = evalUni (substInfinitesimalLinearUni b c At') x" proof(cases At) case (Less p) then show ?thesis using At'[symmetric] Some[symmetric] apply(cases "MPoly_Type.degree p var < 3") by simp_all next case (Eq p) then show ?thesis using At'[symmetric] Some[symmetric] apply(cases "MPoly_Type.degree p var < 3") by simp_all next case (Leq x3) then show ?thesis using At' Some by auto next case (Neq x4) then show ?thesis using At' Some by auto qed show ?thesis unfolding convert_substInfinitesimalLinear[OF Some b_def[symmetric] c_def[symmetric] Cons(2) h1 h2 assms(3)] using h . qed show ?case unfolding L2' using h Cons(1)[OF Cons(2) L2's] by auto qed have quadratic_1 : "(a ≠ 0) ⟹ (4 * a * c ≤ b⇧2) ⟹ (∀f∈set L2. eval (substInfinitesimalQuadratic var (- isolate_variable_sparse p var (Suc 0)) 1 ((isolate_variable_sparse p var (Suc 0))⇧2 - 4 * isolate_variable_sparse p var 2 * isolate_variable_sparse p var 0) (2 * isolate_variable_sparse p var 2) f) (xs' @ x # xs)) = (∀l∈set L2'. evalUni (substInfinitesimalQuadraticUni (- b) 1 (b⇧2 - 4 * a * c) (2 * a) l) x)" using assms(2) proof(induction L2 arbitrary: L2') case Nil then show ?case by auto next case (Cons At L2) have "∃At'. convert_atom var At (xs' @ x # xs) = Some At'" proof(cases At) case (Less p) then show ?thesis using Cons(4) apply simp apply(cases "MPoly_Type.degree p var < 3") by simp_all next case (Eq p) then show ?thesis using Cons(4) apply simp apply(cases "MPoly_Type.degree p var < 3") by simp_all next case (Leq p) then show ?thesis using Cons(4) apply simp apply(cases "MPoly_Type.degree p var < 3") by auto next case (Neq p) then show ?thesis using Cons(4) apply simp apply(cases "MPoly_Type.degree p var < 3") by auto qed then obtain At' where At' : "convert_atom var At (xs' @ x # xs) = Some At'" by auto have "∃L2's. convert_atom_list var L2 (xs' @ x # xs) = Some L2's" using Cons(4) At' apply(cases "convert_atom_list var L2 (xs' @ x # xs)") by auto then obtain L2's where L2's : "convert_atom_list var L2 (xs' @ x # xs) = Some L2's" by auto have L2' : "L2' = At' # L2's" using Cons(4) At' apply(cases At) apply auto by (simp_all add: L2's) have h1 : "var < length (xs' @ x # xs)" using assms by auto have h2 : "2*a ≠0" using Cons by auto have h3 : "0≤b^2-4*a*c" using Cons(3) by auto have h4 : "var∉vars ((isolate_variable_sparse p var (Suc 0))⇧2 - 4 * isolate_variable_sparse p var 2 * isolate_variable_sparse p var 0)" by (metis add_uminus_conv_diff not_in_add not_in_isovarspar not_in_mult not_in_neg not_in_pow num_double numeral_times_numeral one_add_one power_0) have h5 : "∀xa. insertion (nth_default 0 ((xs' @ x # xs)[var := xa])) (- isolate_variable_sparse p var (Suc 0)) = -b" unfolding insertion_neg b_def by (metis insertion_isovarspars_free list_update_id) have h6 : "∀xa. insertion (nth_default 0 ((xs' @ x # xs)[var := xa])) 1 = 1" by auto have h7 : "∀xa. insertion (nth_default 0 ((xs' @ x # xs)[var := xa])) ((isolate_variable_sparse p var (Suc 0))⇧2 - 4 * isolate_variable_sparse p var 2 * isolate_variable_sparse p var 0) = b⇧2 - 4 * a * c" apply(simp add: insertion_four insertion_mult insertion_sub insertion_pow b_def a_def c_def) by (metis insertion_isovarspars_free list_update_id) have "⋀xa. insertion (nth_default 0 (xs' @ xa # xs)) (2::real mpoly) = (2::real)" by (metis MPoly_Type.insertion_one insertion_add one_add_one) then have h8 : "∀xa. insertion (nth_default 0 ((xs' @ x # xs)[var := xa])) (2 * isolate_variable_sparse p var 2) = 2 * a" unfolding insertion_mult a_def apply auto by (metis assms(3) insertion_lowerPoly1 list_update_length not_in_isovarspar) have h9 : "var∉vars(- isolate_variable_sparse p var (Suc 0))" by (simp add: not_in_isovarspar not_in_neg) have h10 : "var∉vars(1::real mpoly)" by (metis h9 not_in_pow power.simps(1)) have h11 : "var∉vars(2 * isolate_variable_sparse p var 2)" by (metis isovarspar_sum mult_2 not_in_isovarspar) have h : "eval (substInfinitesimalQuadratic var (- isolate_variable_sparse p var (Suc 0)) 1 ((isolate_variable_sparse p var (Suc 0))⇧2 - 4 * isolate_variable_sparse p var 2 * isolate_variable_sparse p var 0) (2 * isolate_variable_sparse p var 2) At) (xs' @ x # xs) = evalUni (substInfinitesimalQuadraticUni (- b) 1 (b⇧2 - 4 * a * c) (2 * a) At') x" proof (cases "convert_atom var At (xs' @ x # xs)") case None then show ?thesis using At' apply(cases At) by auto next case (Some aT) have h1 : "insertion (nth_default 0 (xs' @ x # xs)) (- isolate_variable_sparse p var (Suc 0)) = (-b)" unfolding b_def insertion_neg by auto have h2 : "insertion (nth_default 0 (xs' @ x # xs)) 1 = 1" by auto have h3 : "insertion (nth_default 0 (xs' @ x # xs)) (((isolate_variable_sparse p var (Suc 0))⇧2 - 4 * isolate_variable_sparse p var 2 * isolate_variable_sparse p var 0)) = (b⇧2 - 4 * a * c)" unfolding insertion_mult insertion_pow insertion_four insertion_neg insertion_sub a_def b_def c_def by auto have h4 : "insertion (nth_default 0 (xs' @ x # xs)) (2 * isolate_variable_sparse p var 2) = 2 * a" unfolding insertion_mult a_def by (metis insertion_add insertion_mult mult_2) have h5 : "2 * a ≠ 0" using Cons by auto have h6 : "0 ≤ b⇧2 - 4 * a * c" using Cons by auto have h7 : "var∉vars(- isolate_variable_sparse p var (Suc 0))" by (simp add: not_in_isovarspar not_in_neg) have h8 : "var∉vars(1::real mpoly)" by (metis h9 not_in_pow power.simps(1)) have h9 : "var ∉ vars ((isolate_variable_sparse p var (Suc 0))⇧2 - 4 * isolate_variable_sparse p var 2 * isolate_variable_sparse p var 0)" by (metis add_uminus_conv_diff not_in_add not_in_isovarspar not_in_mult not_in_neg not_in_pow num_double numeral_times_numeral one_add_one power_0) have h10 : "var∉vars(2 * isolate_variable_sparse p var 2)" by (metis isovarspar_sum mult_2 not_in_isovarspar) have h : "evalUni (substInfinitesimalQuadraticUni (- b) 1 (b⇧2 - 4 * a * c) (2 * a) aT) x = evalUni (substInfinitesimalQuadraticUni (- b) 1 (b⇧2 - 4 * a * c) (2 * a) At') x"proof(cases At) case (Less p) then show ?thesis using At'[symmetric] Some[symmetric] apply(cases "MPoly_Type.degree p var < 3") by auto next case (Eq p) then show ?thesis using At'[symmetric] Some[symmetric] apply(cases "MPoly_Type.degree p var < 3") by auto next case (Leq x3) then show ?thesis using At' using Some by auto next case (Neq x4) then show ?thesis using At' using Some by auto qed show ?thesis unfolding convert_substInfinitesimalQuadratic[OF Some h1 h2 h3 h4 h5 h6 h7 h8 h9 h10 assms(3)] using h . qed show ?case unfolding L2' apply(simp del : substInfinitesimalQuadratic.simps substInfinitesimalQuadraticUni.simps) unfolding Cons(1)[OF Cons(2) Cons(3) L2's] unfolding h by auto qed have quadratic_2 : "(a ≠ 0) ⟹ (4 * a * c ≤ b⇧2) ⟹ (∀f∈set L2. eval (substInfinitesimalQuadratic var (- isolate_variable_sparse p var (Suc 0)) (- 1) ((isolate_variable_sparse p var (Suc 0))⇧2 - 4 * isolate_variable_sparse p var 2 * isolate_variable_sparse p var 0) (2 * isolate_variable_sparse p var 2) f) (xs' @ x # xs)) = (∀l∈set L2'. evalUni (substInfinitesimalQuadraticUni (- b) (- 1) (b⇧2 - 4 * a * c) (2 * a) l) x)" using assms(2) proof(induction L2 arbitrary: L2') case Nil then show ?case by auto next case (Cons At L2) have "∃At'. convert_atom var At (xs' @ x # xs) = Some At'" proof(cases At) case (Less p) then show ?thesis using Cons(4) apply simp apply(cases "MPoly_Type.degree p var < 3") by simp_all next case (Eq p) then show ?thesis using Cons(4) apply simp apply(cases "MPoly_Type.degree p var < 3") by simp_all next case (Leq p) then show ?thesis using Cons(4) apply simp apply(cases "MPoly_Type.degree p var < 3") by auto next case (Neq p) then show ?thesis using Cons(4) apply simp apply(cases "MPoly_Type.degree p var < 3") by auto qed then obtain At' where At' : "convert_atom var At (xs' @ x # xs) = Some At'" by auto have "∃L2's. convert_atom_list var L2 (xs' @ x # xs) = Some L2's" using Cons(4) At' apply(cases "convert_atom_list var L2 (xs' @ x # xs)") by auto then obtain L2's where L2's : "convert_atom_list var L2 (xs' @ x # xs) = Some L2's" by auto have L2' : "L2' = At' # L2's" using Cons(4) At' apply(cases At) apply auto by (simp_all add: L2's) have h1 : "var < length (xs' @ x # xs)" using assms by auto have h2 : "2*a ≠0" using Cons by auto have h3 : "0≤b^2-4*a*c" using Cons(3) by auto have h4 : "var∉vars ((isolate_variable_sparse p var (Suc 0))⇧2 - 4 * isolate_variable_sparse p var 2 * isolate_variable_sparse p var 0)" by (metis add_uminus_conv_diff not_in_add not_in_isovarspar not_in_mult not_in_neg not_in_pow num_double numeral_times_numeral one_add_one power_0) have h5 : "∀xa. insertion (nth_default 0 ((xs' @ x # xs)[var := xa])) (- isolate_variable_sparse p var (Suc 0)) = -b" unfolding insertion_neg b_def by (metis insertion_isovarspars_free list_update_id) have h6 : "∀xa. insertion (nth_default 0 ((xs' @ x # xs)[var := xa])) (-1) = (-1)" unfolding insertion_neg by auto have h7 : "∀xa. insertion (nth_default 0 ((xs' @ x # xs)[var := xa])) ((isolate_variable_sparse p var (Suc 0))⇧2 - 4 * isolate_variable_sparse p var 2 * isolate_variable_sparse p var 0) = b⇧2 - 4 * a * c" apply(simp add: insertion_four insertion_mult insertion_sub insertion_pow b_def a_def c_def) using assms by (metis insertion_isovarspars_free list_update_id) have "⋀xa. insertion (nth_default 0 (xs' @ xa # xs)) (2::real mpoly) = (2::real)" by (metis MPoly_Type.insertion_one insertion_add one_add_one) then have h8 : "∀xa. insertion (nth_default 0 ((xs' @ x # xs)[var := xa])) (2 * isolate_variable_sparse p var 2) = 2 * a" unfolding insertion_mult a_def apply auto using assms by (metis (no_types, hide_lams) MPoly_Type.insertion_one add.inverse_inverse add_uminus_conv_diff arith_special(3) insertion_isovarspars_free insertion_neg insertion_sub list_update_id) have h9 : "var∉vars(- isolate_variable_sparse p var (Suc 0))" by (simp add: not_in_isovarspar not_in_neg) have h10 : "var∉vars(- 1::real mpoly)" by (metis h9 not_in_neg not_in_pow power.simps(1)) have h11 : "var∉vars(2 * isolate_variable_sparse p var 2)" by (metis isovarspar_sum mult_2 not_in_isovarspar) have h : "eval (substInfinitesimalQuadratic var (- isolate_variable_sparse p var (Suc 0)) (-1) ((isolate_variable_sparse p var (Suc 0))⇧2 - 4 * isolate_variable_sparse p var 2 * isolate_variable_sparse p var 0) (2 * isolate_variable_sparse p var 2) At) (xs' @ x # xs) = evalUni (substInfinitesimalQuadraticUni (- b) (-1) (b⇧2 - 4 * a * c) (2 * a) At') x" proof (cases "convert_atom var At (xs' @ x # xs)") case None then show ?thesis using At' apply(cases At) by auto next case (Some aT) have h1 : "insertion (nth_default 0 (xs' @ x # xs)) (- isolate_variable_sparse p var (Suc 0)) = (-b)" unfolding b_def insertion_neg by auto have h2 : "insertion (nth_default 0 (xs' @ x # xs)) (-1) = -1" unfolding insertion_neg by auto have h3 : "insertion (nth_default 0 (xs' @ x # xs)) (((isolate_variable_sparse p var (Suc 0))⇧2 - 4 * isolate_variable_sparse p var 2 * isolate_variable_sparse p var 0)) = (b⇧2 - 4 * a * c)" unfolding insertion_mult insertion_pow insertion_four insertion_neg insertion_sub a_def b_def c_def using assms by auto have h4 : "insertion (nth_default 0 (xs' @ x # xs)) (2 * isolate_variable_sparse p var 2) = 2 * a" unfolding insertion_mult a_def by (metis insertion_add insertion_mult mult_2) have h5 : "2 * a ≠ 0" using Cons by auto have h6 : "0 ≤ b⇧2 - 4 * a * c" using Cons by auto have h7 : "var∉vars(- isolate_variable_sparse p var (Suc 0))" by (simp add: not_in_isovarspar not_in_neg) have h8 : "var∉vars(- 1::real mpoly)" by (simp add: h10 not_in_neg) have h9 : "var ∉ vars ((isolate_variable_sparse p var (Suc 0))⇧2 - 4 * isolate_variable_sparse p var 2 * isolate_variable_sparse p var 0)" by (metis add_uminus_conv_diff not_in_add not_in_isovarspar not_in_mult not_in_neg not_in_pow num_double numeral_times_numeral one_add_one power_0) have h10 : "var∉vars(2 * isolate_variable_sparse p var 2)" by (metis isovarspar_sum mult_2 not_in_isovarspar) have h : "evalUni (substInfinitesimalQuadraticUni (- b) (-1) (b⇧2 - 4 * a * c) (2 * a) aT) x = evalUni (substInfinitesimalQuadraticUni (- b) (-1) (b⇧2 - 4 * a * c) (2 * a) At') x"proof(cases At) case (Less p) then show ?thesis using At'[symmetric] Some[symmetric] apply(cases "MPoly_Type.degree p var < 3") by auto next case (Eq p) then show ?thesis using At'[symmetric] Some[symmetric] apply(cases "MPoly_Type.degree p var < 3") by auto next case (Leq x3) then show ?thesis using At' using Some option.inject by auto next case (Neq x4) then show ?thesis using At' using Some by auto qed show ?thesis unfolding convert_substInfinitesimalQuadratic[OF Some h1 h2 h3 h4 h5 h6 h7 h8 h9 h10 assms(3)] using h . qed show ?case unfolding L2' apply(simp del : substInfinitesimalQuadratic.simps substInfinitesimalQuadraticUni.simps) unfolding Cons(1)[OF Cons(2) Cons(3) L2's] unfolding h by auto qed show ?thesis using assms(1)[symmetric] unfolding Less apply(cases "MPoly_Type.degree p var < 3") apply simp_all apply(simp del : substInfinitesimalLinear.simps substInfinitesimalLinearUni.simps substInfinitesimalQuadratic.simps substInfinitesimalQuadraticUni.simps add: insertion_neg insertion_mult insertion_add insertion_pow insertion_sub insertion_four a_def[symmetric] b_def[symmetric] c_def[symmetric] a_def'[symmetric] b_def'[symmetric] c_def'[symmetric] eval_list_conj eval_list_conj_Uni ) using linear quadratic_1 quadratic_2 by smt next case (Eq p) define a where "a = insertion (nth_default 0 (xs' @ x # xs)) (isolate_variable_sparse p var 2)" have a_def' : "a = insertion (nth_default 0 (xs' @ 0 # xs)) (isolate_variable_sparse p var 2)" unfolding a_def using insertion_isovarspars_free[of "xs' @x#xs" var x p 2 0] using assms by auto define b where "b = insertion (nth_default 0 (xs' @ x # xs)) (isolate_variable_sparse p var (Suc 0))" have b_def' : "b = insertion (nth_default 0 (xs' @ 0 # xs)) (isolate_variable_sparse p var (Suc 0))" unfolding b_def using insertion_isovarspars_free[of "xs' @x#xs" var x p "(Suc 0)" 0] using assms by auto define c where "c = insertion (nth_default 0 (xs' @ x # xs)) (isolate_variable_sparse p var 0)" have c_def' : "c = insertion (nth_default 0 (xs' @ 0 # xs)) (isolate_variable_sparse p var 0)" unfolding c_def using insertion_isovarspars_free[of "xs' @x#xs" var x p 0 0]using assms by auto have linear : "a=0 ⟹ b≠0 ⟹ (∀f∈set L2. aEval (linear_substitution var (-isolate_variable_sparse p var 0) (isolate_variable_sparse p var (Suc 0)) f) (xs' @ x # xs)) = (∀l∈set L2'. evalUni (linearSubstitutionUni b c l) x)" using assms(2) proof(induction L2 arbitrary: L2') case Nil then show ?case by auto next case (Cons At L2) have "∃At'. convert_atom var At (xs' @ x # xs) = Some At'" proof(cases At) case (Less p) then show ?thesis using Cons(4) apply simp apply(cases "MPoly_Type.degree p var < 3") by simp_all next case (Eq p) then show ?thesis using Cons(4) apply simp apply(cases "MPoly_Type.degree p var < 3") by simp_all next case (Leq p) then show ?thesis using Cons(4) apply simp apply(cases "MPoly_Type.degree p var < 3") by auto next case (Neq p) then show ?thesis using Cons(4) apply simp apply(cases "MPoly_Type.degree p var < 3") by auto qed then obtain At' where At' : "convert_atom var At (xs' @ x # xs) = Some At'" by auto have "∃L2's. convert_atom_list var L2 (xs' @ x # xs) = Some L2's" using Cons(4) At' apply(cases "convert_atom_list var L2 (xs' @ x # xs)") by auto then obtain L2's where L2's : "convert_atom_list var L2 (xs' @ x # xs) = Some L2's" by auto have L2' : "L2' = At' # L2's" using Cons(4) At' apply(cases At) apply auto by (simp_all add: L2's) have h1 : "var ∉ vars (isolate_variable_sparse p var (Suc 0))" by (simp add: not_in_isovarspar) have h2 : "var ∉ vars (isolate_variable_sparse p var 0)"by (simp add: not_in_isovarspar) have h : "aEval (linear_substitution var (-isolate_variable_sparse p var 0) (isolate_variable_sparse p var (Suc 0)) At) (xs' @ x # xs) = evalUni (linearSubstitutionUni b c At') x" proof(cases "convert_atom var At (xs' @ x # xs)") case None then show ?thesis using At' apply(cases At) by auto next case (Some a) have h : "a=At'" using At' Some by auto show ?thesis unfolding convert_linearSubstitutionUni[OF Some b_def[symmetric] c_def[symmetric] Cons(3) h1 h2 assms(3)] unfolding h by auto qed have "(∀f∈set (At # L2). aEval (linear_substitution var (-isolate_variable_sparse p var 0) (isolate_variable_sparse p var (Suc 0)) f) (xs' @ x # xs)) = (aEval (linear_substitution var (-isolate_variable_sparse p var 0)(isolate_variable_sparse p var (Suc 0)) At) (xs' @ x # xs)∧ (∀f∈set (L2). aEval (linear_substitution var (-isolate_variable_sparse p var 0) (isolate_variable_sparse p var (Suc 0)) f) (xs' @ x # xs)))" by auto also have "... = (evalUni (linearSubstitutionUni b c At') x ∧ (∀l∈set L2's. evalUni (linearSubstitutionUni b c l) x))" unfolding h Cons(1)[OF Cons(2) Cons(3) L2's] by auto finally show ?case unfolding L2' by auto qed have quadratic_1 : "(a ≠ 0) ⟹ (4 * a * c ≤ b⇧2) ⟹(∀f∈set L2. eval (quadratic_sub var (- isolate_variable_sparse p var (Suc 0)) 1 ((isolate_variable_sparse p var (Suc 0))⇧2 - 4 * isolate_variable_sparse p var 2 * isolate_variable_sparse p var 0) (2 * isolate_variable_sparse p var 2) f) (xs' @ x # xs)) = (∀l∈set L2'. evalUni (quadraticSubUni (- b) 1 (b⇧2 - 4 * a * c) (2 * a) l) x)" using assms(2) proof(induction L2 arbitrary: L2') case Nil then show ?case by auto next case (Cons At L2) have "∃At'. convert_atom var At (xs' @ x # xs) = Some At'" proof(cases At) case (Less p) then show ?thesis using Cons(4) apply simp apply(cases "MPoly_Type.degree p var < 3") by simp_all next case (Eq p) then show ?thesis using Cons(4) apply simp apply(cases "MPoly_Type.degree p var < 3") by simp_all next case (Leq p) then show ?thesis using Cons(4) apply simp apply(cases "MPoly_Type.degree p var < 3") by auto next case (Neq p) then show ?thesis using Cons(4) apply simp apply(cases "MPoly_Type.degree p var < 3") by auto qed then obtain At' where At' : "convert_atom var At (xs' @ x # xs) = Some At'" by auto have "∃L2's. convert_atom_list var L2 (xs' @ x # xs) = Some L2's" using Cons(4) At' apply(cases "convert_atom_list var L2 (xs' @ x # xs)") by auto then obtain L2's where L2's : "convert_atom_list var L2 (xs' @ x # xs) = Some L2's" by auto have L2' : "L2' = At' # L2's" using Cons(4) At' apply(cases At) apply auto by (simp_all add: L2's) have h1 : "var < length (xs' @ x # xs)" using assms by auto have h2 : "2*a ≠0" using Cons by auto have h3 : "0≤b^2-4*a*c" using Cons(3) by auto have h4 : "var∉vars ((isolate_variable_sparse p var (Suc 0))⇧2 - 4 * isolate_variable_sparse p var 2 * isolate_variable_sparse p var 0)" by (metis add_uminus_conv_diff not_in_add not_in_isovarspar not_in_mult not_in_neg not_in_pow num_double numeral_times_numeral one_add_one power_0) have h5 : "∀xa. insertion (nth_default 0 ((xs' @ x # xs)[var := xa])) (- isolate_variable_sparse p var (Suc 0)) = -b" unfolding insertion_neg b_def by (metis insertion_isovarspars_free list_update_id) have h6 : "∀xa. insertion (nth_default 0 ((xs' @ x # xs)[var := xa])) 1 = 1" by auto have h7 : "∀xa. insertion (nth_default 0 ((xs' @ x # xs)[var := xa])) ((isolate_variable_sparse p var (Suc 0))⇧2 - 4 * isolate_variable_sparse p var 2 * isolate_variable_sparse p var 0) = b⇧2 - 4 * a * c" apply(simp add: insertion_four insertion_mult insertion_sub insertion_pow b_def a_def c_def) by (metis insertion_isovarspars_free list_update_id) have "⋀xa. insertion (nth_default 0 (xs' @ xa # xs)) (2::real mpoly) = (2::real)" by (metis MPoly_Type.insertion_one insertion_add one_add_one) then have h8 : "∀xa. insertion (nth_default 0 ((xs' @ x # xs)[var := xa])) (2 * isolate_variable_sparse p var 2) = 2 * a" unfolding insertion_mult a_def apply auto by (metis assms(3) insertion_add insertion_isovarspars_free insertion_mult list_update_length mult_2) have h9 : "var∉vars(- isolate_variable_sparse p var (Suc 0))" by (simp add: not_in_isovarspar not_in_neg) have h10 : "var∉vars(1::real mpoly)" by (metis h9 not_in_pow power.simps(1)) have h11 : "var∉vars(2 * isolate_variable_sparse p var 2)" by (metis isovarspar_sum mult_2 not_in_isovarspar) have h : "eval (quadratic_sub var (- isolate_variable_sparse p var (Suc 0)) 1 ((isolate_variable_sparse p var (Suc 0))⇧2 - 4 * isolate_variable_sparse p var 2 * isolate_variable_sparse p var 0) (2 * isolate_variable_sparse p var 2) At) (xs' @ x # xs) = aEval At (xs' @ (((- b + 1 * sqrt (b⇧2 - 4 * a * c)) / (2 * a)) # xs))" using quadratic_sub[OF h1 h2 h3 h4 h5 h6 h7 h8, symmetric, of At] free_in_quad[OF h9 h10 h4 h11] by (metis assms(3) list_update_length var_not_in_eval3) have h2 : "aEval At (xs' @ (- b + 1 * sqrt (b⇧2 - 4 * a * c)) / (2 * a) # xs) = evalUni (quadraticSubUni (- b) 1 (b⇧2 - 4 * a * c) (2 * a) At') x" proof(cases At) case (Less p) then show ?thesis proof(cases "convert_atom var At (xs' @ x # xs)") case None then show ?thesis using At'[symmetric] apply(cases "MPoly_Type.degree p var < 3") by simp_all next case (Some aT) then have Some : "⋀x. convert_atom var At (xs' @ x # xs) = Some aT" by (metis assms(3) convert_atom_change) show ?thesis unfolding aEval_aEvalUni[OF Some assms(3)] using At'[symmetric] Some[symmetric] unfolding Less apply(cases "MPoly_Type.degree p var < 3") by simp_all qed next case (Eq p) then show ?thesis proof(cases "convert_atom var At (xs' @ x # xs)") case None then show ?thesis using At'[symmetric] apply(cases "MPoly_Type.degree p var < 3") by simp_all next case (Some aT) then have Some : "⋀x. convert_atom var At (xs' @ x # xs) = Some aT" by (metis assms(3) convert_atom_change) show ?thesis unfolding aEval_aEvalUni[OF Some assms(3)] using At'[symmetric] Some[symmetric] unfolding Eq apply(cases "MPoly_Type.degree p var < 3") by simp_all qed next case (Leq x3) then show ?thesis proof(cases "convert_atom var At (xs' @ x # xs)") case None then show ?thesis using At'[symmetric] apply(cases "MPoly_Type.degree p var < 3") by simp_all next case (Some aT) then have Some : "⋀x. convert_atom var At (xs' @ x # xs) = Some aT" by (metis assms(3) convert_atom_change) show ?thesis unfolding aEval_aEvalUni[OF Some assms(3)] using At'[symmetric] Some[symmetric] unfolding Leq apply(cases "MPoly_Type.degree p var < 3") by auto qed next case (Neq x4) then show ?thesis proof(cases "convert_atom var At (xs' @ x # xs)") case None then show ?thesis using At'[symmetric] apply(cases "MPoly_Type.degree p var < 3") by simp_all next case (Some aT) then have Some : "⋀x. convert_atom var At (xs' @ x # xs) = Some aT" by (metis assms(3) convert_atom_change) show ?thesis unfolding aEval_aEvalUni[OF Some assms(3)] using At'[symmetric] Some[symmetric] unfolding Neq apply(cases "MPoly_Type.degree p var < 3") by auto qed qed show ?case unfolding L2' apply(simp del : quadratic_sub.simps quadraticSubUni.simps) unfolding Cons(1)[OF Cons(2) Cons(3) L2's] unfolding h h2 by auto qed have quadratic_2 : "(a ≠ 0) ⟹ (4 * a * c ≤ b⇧2) ⟹ (∀f∈set L2. eval (quadratic_sub var (- isolate_variable_sparse p var (Suc 0)) (- 1) ((isolate_variable_sparse p var (Suc 0))⇧2 - 4 * isolate_variable_sparse p var 2 * isolate_variable_sparse p var 0) (2 * isolate_variable_sparse p var 2) f) (xs' @ x # xs)) = (∀l∈set L2'. evalUni (quadraticSubUni (- b) (- 1) (b⇧2 - 4 * a * c) (2 * a) l) x)" using assms(2) proof(induction L2 arbitrary: L2') case Nil then show ?case by auto next case (Cons At L2) have "∃At'. convert_atom var At (xs' @ x # xs) = Some At'" proof(cases At) case (Less p) then show ?thesis using Cons(4) apply simp apply(cases "MPoly_Type.degree p var < 3") by simp_all next case (Eq p) then show ?thesis using Cons(4) apply simp apply(cases "MPoly_Type.degree p var < 3") by simp_all next case (Leq p) then show ?thesis using Cons(4) apply simp apply(cases "MPoly_Type.degree p var < 3") by auto next case (Neq p) then show ?thesis using Cons(4) apply simp apply(cases "MPoly_Type.degree p var < 3") by auto qed then obtain At' where At' : "convert_atom var At (xs' @ x # xs) = Some At'" using assms by auto have "∃L2's. convert_atom_list var L2 (xs' @ x # xs) = Some L2's" using Cons(4) At' apply(cases "convert_atom_list var L2 (xs' @ x # xs)") by auto then obtain L2's where L2's : "convert_atom_list var L2 (xs' @ x # xs) = Some L2's" by auto have L2' : "L2' = At' # L2's" using Cons(4) At' apply(cases At) apply auto by (simp_all add: L2's) have h1 : "var < length (xs' @ x # xs)" using assms by auto have h2 : "2*a ≠0" using Cons by auto have h3 : "0≤b^2-4*a*c" using Cons(3) by auto have h4 : "var∉vars ((isolate_variable_sparse p var (Suc 0))⇧2 - 4 * isolate_variable_sparse p var 2 * isolate_variable_sparse p var 0)" by (metis add_uminus_conv_diff not_in_add not_in_isovarspar not_in_mult not_in_neg not_in_pow num_double numeral_times_numeral one_add_one power_0) have h5 : "∀xa. insertion (nth_default 0 ((xs' @ x # xs)[var := xa])) (- isolate_variable_sparse p var (Suc 0)) = -b" unfolding insertion_neg b_def by (metis insertion_isovarspars_free list_update_id) have h6 : "∀xa. insertion (nth_default 0 ((xs' @ x # xs)[var := xa])) (-1) = -1" unfolding insertion_neg by auto have h7 : "∀xa. insertion (nth_default 0 ((xs' @ x # xs)[var := xa])) ((isolate_variable_sparse p var (Suc 0))⇧2 - 4 * isolate_variable_sparse p var 2 * isolate_variable_sparse p var 0) = b⇧2 - 4 * a * c" apply(simp add: insertion_four insertion_mult insertion_sub insertion_pow b_def a_def c_def) by (metis insertion_isovarspars_free list_update_id) have "⋀xa. insertion (nth_default 0 (xs' @xa # xs)) (2::real mpoly) = (2::real)" by (metis MPoly_Type.insertion_one insertion_add one_add_one) then have h8 : "∀xa. insertion (nth_default 0 ((xs' @ x # xs)[var := xa])) (2 * isolate_variable_sparse p var 2) = 2 * a" unfolding insertion_mult a_def apply auto by (metis assms(3) insertion_lowerPoly1 list_update_length not_in_isovarspar) have h9 : "var∉vars(- isolate_variable_sparse p var (Suc 0))" by (simp add: not_in_isovarspar not_in_neg) have h10 : "var∉vars(-1::real mpoly)" by (metis h9 not_in_neg not_in_pow power.simps(1)) have h11 : "var∉vars(2 * isolate_variable_sparse p var 2)" by (metis isovarspar_sum mult_2 not_in_isovarspar) have h : "eval (quadratic_sub var (- isolate_variable_sparse p var (Suc 0)) (-1) ((isolate_variable_sparse p var (Suc 0))⇧2 - 4 * isolate_variable_sparse p var 2 * isolate_variable_sparse p var 0) (2 * isolate_variable_sparse p var 2) At) (xs' @ x # xs) = aEval At (xs' @ (((- b - 1 * sqrt (b⇧2 - 4 * a * c)) / (2 * a)) # xs))" using quadratic_sub[OF h1 h2 h3 h4 h5 h6 h7 h8, symmetric, of At] var_not_in_eval3 free_in_quad[OF h9 h10 h4 h11] using assms(3) by fastforce have h2 : "aEval At (xs' @ (- b - 1 * sqrt (b⇧2 - 4 * a * c)) / (2 * a) # xs) = evalUni (quadraticSubUni (- b) (-1) (b⇧2 - 4 * a * c) (2 * a) At') x" proof(cases At) case (Less p) then show ?thesis proof(cases "convert_atom var At (xs' @ x # xs)") case None then show ?thesis using At'[symmetric] apply(cases "MPoly_Type.degree p var < 3") by simp_all next case (Some aT) then have Some : "⋀x. convert_atom var At (xs' @ x # xs) = Some aT" by (metis assms(3) convert_atom_change) show ?thesis unfolding aEval_aEvalUni[OF Some assms(3)] using At'[symmetric] Some[symmetric] unfolding Less apply(cases "MPoly_Type.degree p var < 3") by simp_all qed next case (Eq p) then show ?thesis proof(cases "convert_atom var At (xs' @ x # xs)") case None then show ?thesis using At'[symmetric] apply(cases "MPoly_Type.degree p var < 3") by simp_all next case (Some aT) then have Some : "⋀x. convert_atom var At (xs' @ x # xs) = Some aT" by (metis assms(3) convert_atom_change) show ?thesis unfolding aEval_aEvalUni[OF Some assms(3)] using At'[symmetric] Some[symmetric] unfolding Eq apply(cases "MPoly_Type.degree p var < 3") by simp_all qed next case (Leq x3) then show ?thesis proof(cases "convert_atom var At (xs' @ x # xs)") case None then show ?thesis using At'[symmetric] apply(cases "MPoly_Type.degree p var < 3") by simp_all next case (Some aT) then have Some : "⋀x. convert_atom var At (xs' @ x # xs) = Some aT" by (metis assms(3) convert_atom_change) show ?thesis unfolding aEval_aEvalUni[OF Some assms(3)] using At'[symmetric] Some[symmetric] unfolding Leq apply(cases "MPoly_Type.degree p var < 3") by auto qed next case (Neq x4) then show ?thesis proof(cases "convert_atom var At (xs' @ x # xs)") case None then show ?thesis using At'[symmetric] apply(cases "MPoly_Type.degree p var < 3") by simp_all next case (Some aT) then have Some : "⋀x. convert_atom var At (xs' @ x # xs) = Some aT" by (metis assms(3) convert_atom_change) show ?thesis unfolding aEval_aEvalUni[OF Some assms(3)] using At'[symmetric] Some[symmetric] unfolding Neq apply(cases "MPoly_Type.degree p var < 3") by auto qed qed show ?case unfolding L2' apply(simp del : quadratic_sub.simps quadraticSubUni.simps) unfolding Cons(1)[OF Cons(2) Cons(3) L2's] unfolding h h2 by auto qed show ?thesis using assms(1)[symmetric] unfolding Eq apply(cases "MPoly_Type.degree p var < 3") apply simp_all apply(simp del : linearSubstitutionUni.simps quadraticSubUni.simps add: insertion_neg insertion_mult insertion_add insertion_pow insertion_sub insertion_four a_def[symmetric] b_def[symmetric] c_def[symmetric] a_def'[symmetric] b_def'[symmetric] c_def'[symmetric] eval_list_conj eval_list_conj_Uni )using linear using quadratic_1 quadratic_2 by smt next case (Leq p) define a where "a = insertion (nth_default 0 (xs' @ x # xs)) (isolate_variable_sparse p var 2)" have a_def' : "a = insertion (nth_default 0 (xs' @ 0 # xs)) (isolate_variable_sparse p var 2)" unfolding a_def using insertion_isovarspars_free[of "xs'@ x#xs" var x p 2 0] using assms by auto define b where "b = insertion (nth_default 0 (xs' @ x # xs)) (isolate_variable_sparse p var (Suc 0))" have b_def' : "b = insertion (nth_default 0 (xs'@ 0 # xs)) (isolate_variable_sparse p var (Suc 0))" unfolding b_def using insertion_isovarspars_free[of "xs'@x#xs" var x p "(Suc 0)" 0] using assms by auto define c where "c = insertion (nth_default 0 (xs' @ x # xs)) (isolate_variable_sparse p var 0)" have c_def' : "c = insertion (nth_default 0 (xs'@ 0 # xs)) (isolate_variable_sparse p var 0)" unfolding c_def using insertion_isovarspars_free[of "xs'@ x#xs" var x p 0 0] using assms by auto have linear : "a=0 ⟹ b≠0 ⟹ (∀f∈set L2. aEval (linear_substitution var (-isolate_variable_sparse p var 0) (isolate_variable_sparse p var (Suc 0)) f) (xs' @ x # xs)) = (∀l∈set L2'. evalUni (linearSubstitutionUni b c l) x)" using assms(2) proof(induction L2 arbitrary: L2') case Nil then show ?case by auto next case (Cons At L2) have "∃At'. convert_atom var At (xs' @ x # xs) = Some At'" proof(cases At) case (Less p) then show ?thesis using Cons(4) apply simp apply(cases "MPoly_Type.degree p var < 3") by simp_all next case (Eq p) then show ?thesis using Cons(4) apply simp apply(cases "MPoly_Type.degree p var < 3") by simp_all next case (Leq p) then show ?thesis using Cons(4) apply simp apply(cases "MPoly_Type.degree p var < 3") by auto next case (Neq p) then show ?thesis using Cons(4) apply simp apply(cases "MPoly_Type.degree p var < 3") by auto qed then obtain At' where At' : "convert_atom var At (xs' @ x # xs) = Some At'" by auto have "∃L2's. convert_atom_list var L2 (xs' @ x # xs) = Some L2's" using Cons(4) At' apply(cases "convert_atom_list var L2 (xs' @ x # xs)") by auto then obtain L2's where L2's : "convert_atom_list var L2 (xs' @ x # xs) = Some L2's" by auto have L2' : "L2' = At' # L2's" using Cons(4) At' apply(cases At) apply auto by (simp_all add: L2's) have h1 : "var ∉ vars (isolate_variable_sparse p var (Suc 0))" by (simp add: not_in_isovarspar) have h2 : "var ∉ vars (isolate_variable_sparse p var 0)"by (simp add: not_in_isovarspar) have h : "aEval (linear_substitution var (-isolate_variable_sparse p var 0) (isolate_variable_sparse p var (Suc 0)) At) (xs' @ x # xs) = evalUni (linearSubstitutionUni b c At') x" proof(cases "convert_atom var At (xs' @ x # xs)") case None then show ?thesis using At' apply(cases At) by auto next case (Some a) have h : "a=At'" using At' Some by auto show ?thesis unfolding convert_linearSubstitutionUni[OF Some b_def[symmetric] c_def[symmetric] Cons(3) h1 h2 assms(3)] unfolding h by auto qed have "(∀f∈set (At # L2). aEval (linear_substitution var (-isolate_variable_sparse p var 0) (isolate_variable_sparse p var (Suc 0)) f) (xs' @ x # xs)) = (aEval (linear_substitution var (-isolate_variable_sparse p var 0) (isolate_variable_sparse p var (Suc 0)) At) (xs' @ x # xs)∧ (∀f∈set (L2). aEval (linear_substitution var (-isolate_variable_sparse p var 0) (isolate_variable_sparse p var (Suc 0)) f) (xs' @ x # xs)))" by auto also have "... = (evalUni (linearSubstitutionUni b c At') x ∧ (∀l∈set L2's. evalUni (linearSubstitutionUni b c l) x))" unfolding h Cons(1)[OF Cons(2) Cons(3) L2's] by auto finally show ?case unfolding L2' by auto qed have quadratic_1 : "(a ≠ 0) ⟹ (4 * a * c ≤ b⇧2) ⟹(∀f∈set L2. eval (quadratic_sub var (- isolate_variable_sparse p var (Suc 0)) 1 ((isolate_variable_sparse p var (Suc 0))⇧2 - 4 * isolate_variable_sparse p var 2 * isolate_variable_sparse p var 0) (2 * isolate_variable_sparse p var 2) f) (xs' @ x # xs)) = (∀l∈set L2'. evalUni (quadraticSubUni (- b) 1 (b⇧2 - 4 * a * c) (2 * a) l) x)" using assms(2) proof(induction L2 arbitrary: L2') case Nil then show ?case by auto next case (Cons At L2) have "∃At'. convert_atom var At (xs' @ x # xs) = Some At'" proof(cases At) case (Less p) then show ?thesis using Cons(4) apply simp apply(cases "MPoly_Type.degree p var < 3") by simp_all next case (Eq p) then show ?thesis using Cons(4) apply simp apply(cases "MPoly_Type.degree p var < 3") by simp_all next case (Leq p) then show ?thesis using Cons(4) apply simp apply(cases "MPoly_Type.degree p var < 3") by auto next case (Neq p) then show ?thesis using Cons(4) apply simp apply(cases "MPoly_Type.degree p var < 3") by auto qed then obtain At' where At' : "convert_atom var At (xs' @ x # xs) = Some At'" by auto have "∃L2's. convert_atom_list var L2 (xs' @ x # xs) = Some L2's" using Cons(4) At' apply(cases "convert_atom_list var L2 (xs' @ x # xs)") by auto then obtain L2's where L2's : "convert_atom_list var L2 (xs' @ x # xs) = Some L2's" by auto have L2' : "L2' = At' # L2's" using Cons(4) At' apply(cases At) apply auto by (simp_all add: L2's) have h1 : "var < length (xs' @ x # xs)" using assms by auto have h2 : "2*a ≠0" using Cons by auto have h3 : "0≤b^2-4*a*c" using Cons(3) by auto have h4 : "var∉vars ((isolate_variable_sparse p var (Suc 0))⇧2 - 4 * isolate_variable_sparse p var 2 * isolate_variable_sparse p var 0)" by (metis add_uminus_conv_diff not_in_add not_in_isovarspar not_in_mult not_in_neg not_in_pow num_double numeral_times_numeral one_add_one power_0) have h5 : "∀xa. insertion (nth_default 0 ((xs' @ x # xs)[var := xa])) (- isolate_variable_sparse p var (Suc 0)) = -b" unfolding insertion_neg b_def by (metis insertion_isovarspars_free list_update_id) have h6 : "∀xa. insertion (nth_default 0 ((xs' @ x # xs)[var := xa])) 1 = 1" by auto have h7 : "∀xa. insertion (nth_default 0 ((xs' @ x # xs)[var := xa])) ((isolate_variable_sparse p var (Suc 0))⇧2 - 4 * isolate_variable_sparse p var 2 * isolate_variable_sparse p var 0) = b⇧2 - 4 * a * c" apply(simp add: insertion_four insertion_mult insertion_sub insertion_pow b_def a_def c_def) by (metis insertion_isovarspars_free list_update_id) have "⋀xa. insertion (nth_default 0 (xs' @xa # xs)) (2::real mpoly) = (2::real)" by (metis MPoly_Type.insertion_one insertion_add one_add_one) then have h8 : "∀xa. insertion (nth_default 0 ((xs' @ x # xs)[var := xa])) (2 * isolate_variable_sparse p var 2) = 2 * a" unfolding insertion_mult a_def apply auto by (metis assms(3) insertion_lowerPoly1 list_update_length not_in_isovarspar) have h9 : "var∉vars(- isolate_variable_sparse p var (Suc 0))" by (simp add: not_in_isovarspar not_in_neg) have h10 : "var∉vars(1::real mpoly)" by (metis h9 not_in_pow power.simps(1)) have h11 : "var∉vars(2 * isolate_variable_sparse p var 2)" by (metis isovarspar_sum mult_2 not_in_isovarspar) have h : "eval (quadratic_sub var (- isolate_variable_sparse p var (Suc 0)) 1 ((isolate_variable_sparse p var (Suc 0))⇧2 - 4 * isolate_variable_sparse p var 2 * isolate_variable_sparse p var 0) (2 * isolate_variable_sparse p var 2) At) (xs' @ x # xs) = aEval At (xs' @ (((- b + 1 * sqrt (b⇧2 - 4 * a * c)) / (2 * a)) # xs))" using quadratic_sub[OF h1 h2 h3 h4 h5 h6 h7 h8, symmetric, of At] var_not_in_eval3 free_in_quad[OF h9 h10 h4 h11] by (metis assms(3) list_update_length) have h2 : "aEval At (xs' @ (- b + 1 * sqrt (b⇧2 - 4 * a * c)) / (2 * a) # xs) = evalUni (quadraticSubUni (- b) 1 (b⇧2 - 4 * a * c) (2 * a) At') x" proof(cases At) case (Less p) then show ?thesis proof(cases "convert_atom var At (xs' @ x # xs)") case None then show ?thesis using At'[symmetric] apply(cases "MPoly_Type.degree p var < 3") by simp_all next case (Some aT) then have Some : "⋀x. convert_atom var At (xs' @ x # xs) = Some aT" by (metis assms(3) convert_atom_change) show ?thesis unfolding aEval_aEvalUni[OF Some assms(3)] using At'[symmetric] Some[symmetric] unfolding Less apply(cases "MPoly_Type.degree p var < 3") by simp_all qed next case (Eq p) then show ?thesis proof(cases "convert_atom var At (xs' @ x # xs)") case None then show ?thesis using At'[symmetric] apply(cases "MPoly_Type.degree p var < 3") by simp_all next case (Some aT) then have Some : "⋀x. convert_atom var At (xs' @ x # xs) = Some aT" by (metis assms(3) convert_atom_change) show ?thesis unfolding aEval_aEvalUni[OF Some assms(3)] using At'[symmetric] Some[symmetric] unfolding Eq apply(cases "MPoly_Type.degree p var < 3") by simp_all qed next case (Leq x3) then show ?thesis proof(cases "convert_atom var At (xs' @ x # xs)") case None then show ?thesis using At'[symmetric] apply(cases "MPoly_Type.degree p var < 3") by simp_all next case (Some aT) then have Some : "⋀x. convert_atom var At (xs' @ x # xs) = Some aT" by (metis assms(3) convert_atom_change) show ?thesis unfolding aEval_aEvalUni[OF Some assms(3)] using At'[symmetric] Some[symmetric] unfolding Leq apply(cases "MPoly_Type.degree p var < 3") by auto qed next case (Neq x4) then show ?thesis proof(cases "convert_atom var At (xs' @ x # xs)") case None then show ?thesis using At'[symmetric] apply(cases "MPoly_Type.degree p var < 3") by simp_all next case (Some aT) then have Some : "⋀x. convert_atom var At (xs' @ x # xs) = Some aT" by (metis assms(3) convert_atom_change) show ?thesis unfolding aEval_aEvalUni[OF Some assms(3)] using At'[symmetric] Some[symmetric] unfolding Neq apply(cases "MPoly_Type.degree p var < 3") by auto qed qed show ?case unfolding L2' apply(simp del : quadratic_sub.simps quadraticSubUni.simps) unfolding Cons(1)[OF Cons(2) Cons(3) L2's] unfolding h h2 by auto qed have quadratic_2 : "(a ≠ 0) ⟹ (4 * a * c ≤ b⇧2) ⟹ (∀f∈set L2. eval (quadratic_sub var (- isolate_variable_sparse p var (Suc 0)) (- 1) ((isolate_variable_sparse p var (Suc 0))⇧2 - 4 * isolate_variable_sparse p var 2 * isolate_variable_sparse p var 0) (2 * isolate_variable_sparse p var 2) f) (xs' @ x # xs)) = (∀l∈set L2'. evalUni (quadraticSubUni (- b) (- 1) (b⇧2 - 4 * a * c) (2 * a) l) x)" using assms(2) proof(induction L2 arbitrary: L2') case Nil then show ?case by auto next case (Cons At L2) have "∃At'. convert_atom var At (xs' @ x # xs) = Some At'" proof(cases At) case (Less p) then show ?thesis using Cons(4) apply simp apply(cases "MPoly_Type.degree p var < 3") by simp_all next case (Eq p) then show ?thesis using Cons(4) apply simp apply(cases "MPoly_Type.degree p var < 3") by simp_all next case (Leq p) then show ?thesis using Cons(4) apply simp apply(cases "MPoly_Type.degree p var < 3") by auto next case (Neq p) then show ?thesis using Cons(4) apply simp apply(cases "MPoly_Type.degree p var < 3") by auto qed then obtain At' where At' : "convert_atom var At (xs' @ x # xs) = Some At'" by auto have "∃L2's. convert_atom_list var L2 (xs' @ x # xs) = Some L2's" using Cons(4) At' apply(cases "convert_atom_list var L2 (xs' @ x # xs)") by auto then obtain L2's where L2's : "convert_atom_list var L2 (xs' @ x # xs) = Some L2's" by auto have L2' : "L2' = At' # L2's" using Cons(4) At' apply(cases At) apply auto by (simp_all add: L2's) have h1 : "var < length (xs' @ x # xs)" using assms by auto have h2 : "2*a ≠0" using Cons by auto have h3 : "0≤b^2-4*a*c" using Cons(3) by auto have h4 : "var∉vars ((isolate_variable_sparse p var (Suc 0))⇧2 - 4 * isolate_variable_sparse p var 2 * isolate_variable_sparse p var 0)" by (metis add_uminus_conv_diff not_in_add not_in_isovarspar not_in_mult not_in_neg not_in_pow num_double numeral_times_numeral one_add_one power_0) have h5 : "∀xa. insertion (nth_default 0 ((xs' @ x # xs)[var := xa])) (- isolate_variable_sparse p var (Suc 0)) = -b" unfolding insertion_neg b_def by (metis insertion_isovarspars_free list_update_id) have h6 : "∀xa. insertion (nth_default 0 ((xs' @ x # xs)[var := xa])) (-1) = -1" unfolding insertion_neg by auto have h7 : "∀xa. insertion (nth_default 0 ((xs' @ x # xs)[var := xa])) ((isolate_variable_sparse p var (Suc 0))⇧2 - 4 * isolate_variable_sparse p var 2 * isolate_variable_sparse p var 0) = b⇧2 - 4 * a * c" apply(simp add: insertion_four insertion_mult insertion_sub insertion_pow b_def a_def c_def) by (metis insertion_isovarspars_free list_update_id) have "⋀xa. insertion (nth_default 0 (xs' @ xa # xs)) (2::real mpoly) = (2::real)" by (metis MPoly_Type.insertion_one insertion_add one_add_one) then have h8 : "∀xa. insertion (nth_default 0 ((xs' @ x # xs)[var := xa])) (2 * isolate_variable_sparse p var 2) = 2 * a" unfolding insertion_mult a_def apply auto by (metis assms(3) insertion_lowerPoly1 list_update_length not_in_isovarspar) have h9 : "var∉vars(- isolate_variable_sparse p var (Suc 0))" by (simp add: not_in_isovarspar not_in_neg) have h10 : "var∉vars(-1::real mpoly)" by (metis h9 not_in_neg not_in_pow power.simps(1)) have h11 : "var∉vars(2 * isolate_variable_sparse p var 2)" by (metis isovarspar_sum mult_2 not_in_isovarspar) have h : "eval (quadratic_sub var (- isolate_variable_sparse p var (Suc 0)) (-1) ((isolate_variable_sparse p var (Suc 0))⇧2 - 4 * isolate_variable_sparse p var 2 * isolate_variable_sparse p var 0) (2 * isolate_variable_sparse p var 2) At) (xs' @ x # xs) = aEval At (xs' @(((- b - 1 * sqrt (b⇧2 - 4 * a * c)) / (2 * a)) # xs))" using quadratic_sub[OF h1 h2 h3 h4 h5 h6 h7 h8, symmetric, of At] var_not_in_eval3 free_in_quad[OF h9 h10 h4 h11] using assms(3) by fastforce have h2 : "aEval At (xs' @(- b - 1 * sqrt (b⇧2 - 4 * a * c)) / (2 * a) # xs) = evalUni (quadraticSubUni (- b) (-1) (b⇧2 - 4 * a * c) (2 * a) At') x" proof(cases At) case (Less p) then show ?thesis proof(cases "convert_atom var At (xs' @ x # xs)") case None then show ?thesis using At'[symmetric] apply(cases "MPoly_Type.degree p var < 3") by simp_all next case (Some aT) then have Some : "⋀x. convert_atom var At (xs' @ x # xs) = Some aT" by (metis assms(3) convert_atom_change) show ?thesis unfolding aEval_aEvalUni[OF Some assms(3)] using At'[symmetric] Some[symmetric] unfolding Less apply(cases "MPoly_Type.degree p var < 3") by simp_all qed next case (Eq p) then show ?thesis proof(cases "convert_atom var At (xs' @ x # xs)") case None then show ?thesis using At'[symmetric] apply(cases "MPoly_Type.degree p var < 3") by simp_all next case (Some aT) then have Some : "⋀x. convert_atom var At (xs' @ x # xs) = Some aT" by (metis assms(3) convert_atom_change) show ?thesis unfolding aEval_aEvalUni[OF Some assms(3)] using At'[symmetric] Some[symmetric] unfolding Eq apply(cases "MPoly_Type.degree p var < 3") by simp_all qed next case (Leq x3) then show ?thesis proof(cases "convert_atom var At (xs' @ x # xs)") case None then show ?thesis using At'[symmetric] apply(cases "MPoly_Type.degree p var < 3") by simp_all next case (Some aT) then have Some : "⋀x. convert_atom var At (xs' @ x # xs) = Some aT" by (metis assms(3) convert_atom_change) show ?thesis unfolding aEval_aEvalUni[OF Some assms(3)] using At'[symmetric] Some[symmetric] unfolding Leq apply(cases "MPoly_Type.degree p var < 3") by (auto) qed next case (Neq x4) then show ?thesis proof(cases "convert_atom var At (xs' @ x # xs)") case None then show ?thesis using At'[symmetric] apply(cases "MPoly_Type.degree p var < 3") by simp_all next case (Some aT) then have Some : "⋀x. convert_atom var At (xs' @ x # xs) = Some aT" by (metis assms(3) convert_atom_change) show ?thesis unfolding aEval_aEvalUni[OF Some assms(3)] using At'[symmetric] Some[symmetric] unfolding Neq apply(cases "MPoly_Type.degree p var < 3") by auto qed qed show ?case unfolding L2' apply(simp del : quadratic_sub.simps quadraticSubUni.simps) unfolding Cons(1)[OF Cons(2) Cons(3) L2's] unfolding h h2 by auto qed show ?thesis using assms(1)[symmetric] unfolding Leq apply(cases "MPoly_Type.degree p var < 3") apply simp_all apply(simp del : linearSubstitutionUni.simps quadraticSubUni.simps add: insertion_neg insertion_mult insertion_add insertion_pow insertion_sub insertion_four a_def[symmetric] b_def[symmetric] c_def[symmetric] a_def'[symmetric] b_def'[symmetric] c_def'[symmetric] eval_list_conj eval_list_conj_Uni ) using linear using quadratic_1 quadratic_2 by smt next case (Neq p) define a where "a = insertion (nth_default 0 (xs' @ x # xs)) (isolate_variable_sparse p var 2)" have a_def' : "a = insertion (nth_default 0 (xs' @ 0 # xs)) (isolate_variable_sparse p var 2)" unfolding a_def using insertion_isovarspars_free[of "xs' @x#xs" var x p 2 0] using assms by auto define b where "b = insertion (nth_default 0 (xs' @ x # xs)) (isolate_variable_sparse p var (Suc 0))" have b_def' : "b = insertion (nth_default 0 (xs' @ 0 # xs)) (isolate_variable_sparse p var (Suc 0))" unfolding b_def using insertion_isovarspars_free[of "xs'@x#xs" var x p "(Suc 0)" 0] using assms by auto define c where "c = insertion (nth_default 0 (xs' @ x # xs)) (isolate_variable_sparse p var 0)" have c_def' : "c = insertion (nth_default 0 (xs'@0 # xs)) (isolate_variable_sparse p var 0)" unfolding c_def using insertion_isovarspars_free[of "xs'@x#xs" var x p 0 0] using assms by auto have linear : "b≠0 ⟹ (∀f∈set L2. eval (substInfinitesimalLinear var (-isolate_variable_sparse p var 0) (isolate_variable_sparse p var (Suc 0)) f) (xs' @ x # xs)) = (∀l∈set L2'. evalUni (substInfinitesimalLinearUni b c l) x)" using assms(2) proof(induction L2 arbitrary : L2') case Nil then show ?case by auto next case (Cons At L2) have "∃At'. convert_atom var At (xs' @ x # xs) = Some At'" proof(cases At) case (Less p) then show ?thesis using Cons(3) apply simp apply(cases "MPoly_Type.degree p var < 3") by simp_all next case (Eq p) then show ?thesis using Cons(3) apply simp apply(cases "MPoly_Type.degree p var < 3") by simp_all next case (Leq p) then show ?thesis using Cons(3) apply simp apply(cases "MPoly_Type.degree p var < 3") by auto next case (Neq p) then show ?thesis using Cons(3) apply simp apply(cases "MPoly_Type.degree p var < 3") by auto qed then obtain At' where At' : "convert_atom var At (xs' @ x # xs) = Some At'" by auto have "∃L2's. convert_atom_list var L2 (xs' @ x # xs) = Some L2's" using Cons(3) At' apply(cases "convert_atom_list var L2 (xs' @ x # xs)") by auto then obtain L2's where L2's : "convert_atom_list var L2 (xs' @ x # xs) = Some L2's" by auto have L2' : "L2' = At' # L2's" using Cons(3) At' by (simp_all add: L2's) have h : "eval (substInfinitesimalLinear var (-isolate_variable_sparse p var 0) (isolate_variable_sparse p var (Suc 0)) At) (xs' @ x # xs) = evalUni (substInfinitesimalLinearUni b c At') x" proof(cases "convert_atom var At (xs' @ x # xs)") case None then show ?thesis using At' apply(cases At) by simp_all next case (Some a) have h1 : "var ∉ vars (isolate_variable_sparse p var (Suc 0))" by (simp add: not_in_isovarspar) have h2 : "var ∉ vars (isolate_variable_sparse p var 0)"by (simp add: not_in_isovarspar) have h : "evalUni (substInfinitesimalLinearUni b c a) x = evalUni (substInfinitesimalLinearUni b c At') x" proof(cases At) case (Less p) then show ?thesis using At'[symmetric] Some[symmetric] apply(cases "MPoly_Type.degree p var < 3") by simp_all next case (Eq p) then show ?thesis using At'[symmetric] Some[symmetric] apply(cases "MPoly_Type.degree p var < 3") by simp_all next case (Leq x3) then show ?thesis using At' Some by auto next case (Neq x4) then show ?thesis using At' Some by auto qed show ?thesis unfolding convert_substInfinitesimalLinear[OF Some b_def[symmetric] c_def[symmetric] Cons(2) h1 h2 assms(3)] using h . qed show ?case unfolding L2' using h Cons(1)[OF Cons(2) L2's] by auto qed have quadratic_1 : "(a ≠ 0) ⟹ (4 * a * c ≤ b⇧2) ⟹ (∀f∈set L2. eval (substInfinitesimalQuadratic var (- isolate_variable_sparse p var (Suc 0)) 1 ((isolate_variable_sparse p var (Suc 0))⇧2 - 4 * isolate_variable_sparse p var 2 * isolate_variable_sparse p var 0) (2 * isolate_variable_sparse p var 2) f) (xs' @ x # xs)) = (∀l∈set L2'. evalUni (substInfinitesimalQuadraticUni (- b) 1 (b⇧2 - 4 * a * c) (2 * a) l) x)" using assms(2) proof(induction L2 arbitrary: L2') case Nil then show ?case by auto next case (Cons At L2) have "∃At'. convert_atom var At (xs' @ x # xs) = Some At'" proof(cases At) case (Less p) then show ?thesis using Cons(4) apply simp apply(cases "MPoly_Type.degree p var < 3") by simp_all next case (Eq p) then show ?thesis using Cons(4) apply simp apply(cases "MPoly_Type.degree p var < 3") by simp_all next case (Leq p) then show ?thesis using Cons(4) apply simp apply(cases "MPoly_Type.degree p var < 3") by auto next case (Neq p) then show ?thesis using Cons(4) apply simp apply(cases "MPoly_Type.degree p var < 3") by auto qed then obtain At' where At' : "convert_atom var At (xs' @ x # xs) = Some At'" by auto have "∃L2's. convert_atom_list var L2 (xs' @ x # xs) = Some L2's" using Cons(4) At' apply(cases "convert_atom_list var L2 (xs' @ x # xs)") by auto then obtain L2's where L2's : "convert_atom_list var L2 (xs' @ x # xs) = Some L2's" by auto have L2' : "L2' = At' # L2's" using Cons(4) At' apply(cases At) apply auto by (simp_all add: L2's) have h1 : "var < length (xs' @ x # xs)" using assms by auto have h2 : "2*a ≠0" using Cons by auto have h3 : "0≤b^2-4*a*c" using Cons(3) by auto have h4 : "var∉vars ((isolate_variable_sparse p var (Suc 0))⇧2 - 4 * isolate_variable_sparse p var 2 * isolate_variable_sparse p var 0)" by (metis add_uminus_conv_diff not_in_add not_in_isovarspar not_in_mult not_in_neg not_in_pow num_double numeral_times_numeral one_add_one power_0) have h5 : "∀xa. insertion (nth_default 0 ((xs' @ x # xs)[var := xa])) (- isolate_variable_sparse p var (Suc 0)) = -b" unfolding insertion_neg b_def by (metis insertion_isovarspars_free list_update_id) have h6 : "∀xa. insertion (nth_default 0 ((xs' @ x # xs)[var := xa])) 1 = 1" by auto have h7 : "∀xa. insertion (nth_default 0 ((xs' @ x # xs)[var := xa])) ((isolate_variable_sparse p var (Suc 0))⇧2 - 4 * isolate_variable_sparse p var 2 * isolate_variable_sparse p var 0) = b⇧2 - 4 * a * c" apply(simp add: insertion_four insertion_mult insertion_sub insertion_pow b_def a_def c_def) by (metis insertion_isovarspars_free list_update_id) have "⋀xa. insertion (nth_default 0 (xs' @xa # xs)) (2::real mpoly) = (2::real)" by (metis MPoly_Type.insertion_one insertion_add one_add_one) then have h8 : "∀xa. insertion (nth_default 0 ((xs' @ x # xs)[var := xa])) (2 * isolate_variable_sparse p var 2) = 2 * a" unfolding insertion_mult a_def apply auto by (metis assms(3) insertion_lowerPoly1 list_update_length not_in_isovarspar) have h9 : "var∉vars(- isolate_variable_sparse p var (Suc 0))" by (simp add: not_in_isovarspar not_in_neg) have h10 : "var∉vars(1::real mpoly)" by (metis h9 not_in_pow power.simps(1)) have h11 : "var∉vars(2 * isolate_variable_sparse p var 2)" by (metis isovarspar_sum mult_2 not_in_isovarspar) have h : "eval (substInfinitesimalQuadratic var (- isolate_variable_sparse p var (Suc 0)) 1 ((isolate_variable_sparse p var (Suc 0))⇧2 - 4 * isolate_variable_sparse p var 2 * isolate_variable_sparse p var 0) (2 * isolate_variable_sparse p var 2) At) (xs' @ x # xs) = evalUni (substInfinitesimalQuadraticUni (- b) 1 (b⇧2 - 4 * a * c) (2 * a) At') x" proof (cases "convert_atom var At (xs' @ x # xs)") case None then show ?thesis using At' apply(cases At) by auto next case (Some aT) have h1 : "insertion (nth_default 0 (xs' @ x # xs)) (- isolate_variable_sparse p var (Suc 0)) = (-b)" unfolding b_def insertion_neg by auto have h2 : "insertion (nth_default 0 (xs' @ x # xs)) 1 = 1" by auto have h3 : "insertion (nth_default 0 (xs' @ x # xs)) (((isolate_variable_sparse p var (Suc 0))⇧2 - 4 * isolate_variable_sparse p var 2 * isolate_variable_sparse p var 0)) = (b⇧2 - 4 * a * c)" unfolding insertion_mult insertion_pow insertion_four insertion_neg insertion_sub a_def b_def c_def by auto have h4 : "insertion (nth_default 0 (xs' @ x # xs)) (2 * isolate_variable_sparse p var 2) = 2 * a" unfolding insertion_mult a_def by (metis insertion_add insertion_mult mult_2) have h5 : "2 * a ≠ 0" using Cons by auto have h6 : "0 ≤ b⇧2 - 4 * a * c" using Cons by auto have h7 : "var∉vars(- isolate_variable_sparse p var (Suc 0))" by (simp add: not_in_isovarspar not_in_neg) have h8 : "var∉vars(1::real mpoly)" by (metis h9 not_in_pow power.simps(1)) have h9 : "var ∉ vars ((isolate_variable_sparse p var (Suc 0))⇧2 - 4 * isolate_variable_sparse p var 2 * isolate_variable_sparse p var 0)" by (metis add_uminus_conv_diff not_in_add not_in_isovarspar not_in_mult not_in_neg not_in_pow num_double numeral_times_numeral one_add_one power_0) have h10 : "var∉vars(2 * isolate_variable_sparse p var 2)" by (metis isovarspar_sum mult_2 not_in_isovarspar) have h : "evalUni (substInfinitesimalQuadraticUni (- b) 1 (b⇧2 - 4 * a * c) (2 * a) aT) x = evalUni (substInfinitesimalQuadraticUni (- b) 1 (b⇧2 - 4 * a * c) (2 * a) At') x"proof(cases At) case (Less p) then show ?thesis using At'[symmetric] Some[symmetric] apply(cases "MPoly_Type.degree p var < 3") by auto next case (Eq p) then show ?thesis using At'[symmetric] Some[symmetric] apply(cases "MPoly_Type.degree p var < 3") by auto next case (Leq x3) then show ?thesis using At' using Some by auto next case (Neq x4) then show ?thesis using At' using Some by auto qed show ?thesis unfolding convert_substInfinitesimalQuadratic[OF Some h1 h2 h3 h4 h5 h6 h7 h8 h9 h10 assms(3)] using h . qed show ?case unfolding L2' apply(simp del : substInfinitesimalQuadratic.simps substInfinitesimalQuadraticUni.simps) unfolding Cons(1)[OF Cons(2) Cons(3) L2's] unfolding h by auto qed have quadratic_2 : "(a ≠ 0) ⟹ (4 * a * c ≤ b⇧2) ⟹ (∀f∈set L2. eval (substInfinitesimalQuadratic var (- isolate_variable_sparse p var (Suc 0)) (- 1) ((isolate_variable_sparse p var (Suc 0))⇧2 - 4 * isolate_variable_sparse p var 2 * isolate_variable_sparse p var 0) (2 * isolate_variable_sparse p var 2) f) (xs' @ x # xs)) = (∀l∈set L2'. evalUni (substInfinitesimalQuadraticUni (- b) (- 1) (b⇧2 - 4 * a * c) (2 * a) l) x)" using assms(2) proof(induction L2 arbitrary: L2') case Nil then show ?case by auto next case (Cons At L2) have "∃At'. convert_atom var At (xs' @ x # xs) = Some At'" proof(cases At) case (Less p) then show ?thesis using Cons(4) apply simp apply(cases "MPoly_Type.degree p var < 3") by simp_all next case (Eq p) then show ?thesis using Cons(4) apply simp apply(cases "MPoly_Type.degree p var < 3") by simp_all next case (Leq p) then show ?thesis using Cons(4) apply simp apply(cases "MPoly_Type.degree p var < 3") by auto next case (Neq p) then show ?thesis using Cons(4) apply simp apply(cases "MPoly_Type.degree p var < 3") by auto qed then obtain At' where At' : "convert_atom var At (xs' @ x # xs) = Some At'" by auto have "∃L2's. convert_atom_list var L2 (xs' @ x # xs) = Some L2's" using Cons(4) At' apply(cases "convert_atom_list var L2 (xs' @ x # xs)") by auto then obtain L2's where L2's : "convert_atom_list var L2 (xs' @ x # xs) = Some L2's" by auto have L2' : "L2' = At' # L2's" using Cons(4) At' apply(cases At) apply auto by (simp_all add: L2's) have h1 : "var < length ((xs' @ x # xs))" using assms by auto have h2 : "2*a ≠0" using Cons by auto have h3 : "0≤b^2-4*a*c" using Cons(3) by auto have h4 : "var∉vars ((isolate_variable_sparse p var (Suc 0))⇧2 - 4 * isolate_variable_sparse p var 2 * isolate_variable_sparse p var 0)" by (metis add_uminus_conv_diff not_in_add not_in_isovarspar not_in_mult not_in_neg not_in_pow num_double numeral_times_numeral one_add_one power_0) have h5 : "∀xa. insertion (nth_default 0 ((xs' @ x # xs)[var := xa])) (- isolate_variable_sparse p var (Suc 0)) = -b" unfolding insertion_neg b_def by (metis insertion_isovarspars_free list_update_id) have h6 : "∀xa. insertion (nth_default 0 ((xs' @ x # xs)[var := xa])) (-1) = (-1)" unfolding insertion_neg by auto have h7 : "∀xa. insertion (nth_default 0 ((xs' @ x # xs)[var := xa])) ((isolate_variable_sparse p var (Suc 0))⇧2 - 4 * isolate_variable_sparse p var 2 * isolate_variable_sparse p var 0) = b⇧2 - 4 * a * c" apply(simp add: insertion_four insertion_mult insertion_sub insertion_pow b_def a_def c_def) by (metis insertion_isovarspars_free list_update_id) have "⋀xa. insertion (nth_default 0 (xs' @ xa # xs)) (2::real mpoly) = (2::real)" by (metis MPoly_Type.insertion_one insertion_add one_add_one) then have h8 : "∀xa. insertion (nth_default 0 ((xs' @ x # xs)[var := xa])) (2 * isolate_variable_sparse p var 2) = 2 * a" unfolding insertion_mult a_def apply auto by (metis assms(3) insertion_lowerPoly1 list_update_length not_in_isovarspar) have h9 : "var∉vars(- isolate_variable_sparse p var (Suc 0))" by (simp add: not_in_isovarspar not_in_neg) have h10 : "var∉vars(- 1::real mpoly)" by (metis h9 not_in_neg not_in_pow power.simps(1)) have h11 : "var∉vars(2 * isolate_variable_sparse p var 2)" by (metis isovarspar_sum mult_2 not_in_isovarspar) have h : "eval (substInfinitesimalQuadratic var (- isolate_variable_sparse p var (Suc 0)) (-1) ((isolate_variable_sparse p var (Suc 0))⇧2 - 4 * isolate_variable_sparse p var 2 * isolate_variable_sparse p var 0) (2 * isolate_variable_sparse p var 2) At) (xs' @ x # xs) = evalUni (substInfinitesimalQuadraticUni (- b) (-1) (b⇧2 - 4 * a * c) (2 * a) At') x" proof (cases "convert_atom var At (xs' @ x # xs)") case None then show ?thesis using At' apply(cases At) by auto next case (Some aT) have h1 : "insertion (nth_default 0 (xs' @ x # xs)) (- isolate_variable_sparse p var (Suc 0)) = (-b)" unfolding b_def insertion_neg by auto have h2 : "insertion (nth_default 0 (xs' @ x # xs)) (-1) = -1" unfolding insertion_neg by auto have h3 : "insertion (nth_default 0 (xs' @ x # xs)) (((isolate_variable_sparse p var (Suc 0))⇧2 - 4 * isolate_variable_sparse p var 2 * isolate_variable_sparse p var 0)) = (b⇧2 - 4 * a * c)" unfolding insertion_mult insertion_pow insertion_four insertion_neg insertion_sub a_def b_def c_def by auto have h4 : "insertion (nth_default 0 (xs' @ x # xs)) (2 * isolate_variable_sparse p var 2) = 2 * a" unfolding insertion_mult a_def by (metis insertion_add insertion_mult mult_2) have h5 : "2 * a ≠ 0" using Cons by auto have h6 : "0 ≤ b⇧2 - 4 * a * c" using Cons by auto have h7 : "var∉vars(- isolate_variable_sparse p var (Suc 0))" by (simp add: not_in_isovarspar not_in_neg) have h8 : "var∉vars(- 1::real mpoly)" by (simp add: h10 not_in_neg) have h9 : "var ∉ vars ((isolate_variable_sparse p var (Suc 0))⇧2 - 4 * isolate_variable_sparse p var 2 * isolate_variable_sparse p var 0)" by (metis add_uminus_conv_diff not_in_add not_in_isovarspar not_in_mult not_in_neg not_in_pow num_double numeral_times_numeral one_add_one power_0) have h10 : "var∉vars(2 * isolate_variable_sparse p var 2)" by (metis isovarspar_sum mult_2 not_in_isovarspar) have h : "evalUni (substInfinitesimalQuadraticUni (- b) (-1) (b⇧2 - 4 * a * c) (2 * a) aT) x = evalUni (substInfinitesimalQuadraticUni (- b) (-1) (b⇧2 - 4 * a * c) (2 * a) At') x"proof(cases At) case (Less p) then show ?thesis using At'[symmetric] Some[symmetric] apply(cases "MPoly_Type.degree p var < 3") by auto next case (Eq p) then show ?thesis using At'[symmetric] Some[symmetric] apply(cases "MPoly_Type.degree p var < 3") by auto next case (Leq x3) then show ?thesis using At' using Some option.inject by auto next case (Neq x4) then show ?thesis using At' using Some by auto qed show ?thesis unfolding convert_substInfinitesimalQuadratic[OF Some h1 h2 h3 h4 h5 h6 h7 h8 h9 h10 assms(3)] using h . qed show ?case unfolding L2' apply(simp del : substInfinitesimalQuadratic.simps substInfinitesimalQuadraticUni.simps) unfolding Cons(1)[OF Cons(2) Cons(3) L2's] unfolding h by auto qed show ?thesis using assms(1)[symmetric] unfolding Neq apply(cases "MPoly_Type.degree p var < 3") apply simp_all apply(simp del : substInfinitesimalLinear.simps substInfinitesimalLinearUni.simps substInfinitesimalQuadratic.simps substInfinitesimalQuadraticUni.simps add: insertion_neg insertion_mult insertion_add insertion_pow insertion_sub insertion_four a_def[symmetric] b_def[symmetric] c_def[symmetric] a_def'[symmetric] b_def'[symmetric] c_def'[symmetric] eval_list_conj eval_list_conj_Uni ) using linear quadratic_1 quadratic_2 by smt qed lemma convert_list : assumes "convert_atom_list var L (xs' @ x # xs) = Some L'" assumes "l∈set(L)" shows "∃l'∈ set L'. convert_atom var l (xs' @ x # xs) = Some l'" using assms proof(induction L arbitrary : L') case Nil then show ?case by auto next case (Cons At L) then show ?case proof(cases At) case (Less p) then show ?thesis using Cons(2)[symmetric] Cons(1) Cons(3) unfolding Less apply simp apply(cases "MPoly_Type.degree p var < 3") apply simp_all apply(cases "convert_atom_list var L (xs' @ x # xs)") apply simp_all apply(cases "l = Less p") by simp_all next case (Eq p) show ?thesis using Cons(2)[symmetric] Cons(1) Cons(3) unfolding Eq apply simp apply(cases "MPoly_Type.degree p var < 3") apply simp_all apply(cases "convert_atom_list var L (xs' @ x # xs)") apply simp_all apply(cases "l = Eq p") by simp_all next case (Leq p) then show ?thesis using Cons(2)[symmetric] Cons(1) Cons(3) unfolding Leq apply simp apply(cases "MPoly_Type.degree p var < 3") apply simp_all apply(cases "convert_atom_list var L (xs' @ x # xs)") apply simp_all apply(cases "l = Leq p") by simp_all next case (Neq p) then show ?thesis using Cons(2)[symmetric] Cons(1) Cons(3) unfolding Neq apply simp apply(cases "MPoly_Type.degree p var < 3") apply simp_all apply(cases "convert_atom_list var L (xs' @ x # xs)") apply simp_all apply(cases "l = Neq p") by simp_all qed qed lemma convert_list2 : assumes "convert_atom_list var L (xs' @ x # xs) = Some L'" assumes "l'∈set(L')" shows "∃l∈ set L. convert_atom var l (xs' @ x # xs) = Some l'" using assms proof(induction L arbitrary : L') case Nil then show ?case by auto next case (Cons At L) then show ?case proof(cases At) case (Less p) then show ?thesis using Cons(2)[symmetric] Cons(1) Cons(3) unfolding Less apply simp apply(cases "MPoly_Type.degree p var < 3") apply simp_all apply(cases "convert_atom_list var L (xs' @ x # xs)") apply simp_all by blast next case (Eq p) show ?thesis using Cons(2)[symmetric] Cons(1) Cons(3) unfolding Eq apply simp apply(cases "MPoly_Type.degree p var < 3") apply simp_all apply(cases "convert_atom_list var L (xs' @ x # xs)") apply simp_all by blast next case (Leq p) then show ?thesis using Cons(2)[symmetric] Cons(1) Cons(3) unfolding Leq apply simp apply(cases "MPoly_Type.degree p var < 3") apply simp_all apply(cases "convert_atom_list var L (xs' @ x # xs)") apply simp_all by blast next case (Neq p) then show ?thesis using Cons(2)[symmetric] Cons(1) Cons(3) unfolding Neq apply simp apply(cases "MPoly_Type.degree p var < 3") apply simp_all apply(cases "convert_atom_list var L (xs' @ x # xs)") apply simp_all by blast qed qed lemma elimVar_atom_convert : assumes "convert_atom_list var L (xs' @ x # xs) = Some L'" assumes "convert_atom_list var L2 (xs' @ x # xs) = Some L2'" assumes "length xs' = var" shows "(∃f∈set L. eval (elimVar var L2 [] f) (xs' @ x # xs)) = (∃f∈set L'. evalUni (elimVarUni_atom L2' f) x)" proof safe fix f assume h : "f ∈ set L" "eval (elimVar var L2 [] f) (xs' @ x # xs)" have "∃f'∈set L'. convert_atom var f (xs' @ x # xs) = Some f'" using convert_list h assms by auto then obtain f' where f' : "f'∈set L'" "convert_atom var f (xs' @ x # xs) = Some f'" by metis show "∃f∈set L'. evalUni (elimVarUni_atom L2' f) x" apply(rule bexI[where x=f']) using f' elimVar_atom_single[OF f'(2) assms(2) assms(3)] h by auto next fix f' assume h : "f' ∈ set L'" "evalUni (elimVarUni_atom L2' f') x" have "∃f∈set L. convert_atom var f (xs' @ x # xs) = Some f'" using convert_list2 h assms by auto then obtain f where f : "f∈set L" "convert_atom var f (xs' @ x # xs) = Some f'" by metis show "∃f∈set L. eval (elimVar var L2 [] f) (xs' @ x # xs)" apply(rule bexI[where x=f]) using f elimVar_atom_single[OF f(2) assms(2) assms(3)] h by auto qed lemma eval_convert : assumes "convert_atom_list var L (xs' @ x # xs) = Some L'" assumes "length xs' = var" shows "(∀f∈set L. aEval f (xs' @ x # xs)) = (∀f∈set L'. aEvalUni f x)" using assms proof(induction L arbitrary : L') case Nil then show ?case by auto next case (Cons a L) then show ?case proof(cases a) case (Less p) then show ?thesis using Cons(2)[symmetric] Cons(1) Cons(3) unfolding Less apply(cases " MPoly_Type.degree p var < 3") apply simp_all apply(cases "convert_atom_list var L (xs' @ x # xs)") apply simp_all by (simp add: poly_to_univar) next case (Eq p) then show ?thesis using Cons(2)[symmetric] Cons(1) Cons(3) unfolding Eq apply(cases " MPoly_Type.degree p var < 3") apply simp_all apply(cases "convert_atom_list var L (xs' @ x # xs)") apply simp_all by (simp add: poly_to_univar) next case (Leq p) show ?thesis using Cons(2)[symmetric] Cons(1) Cons(3) unfolding Leq apply(cases " MPoly_Type.degree p var < 3") apply simp_all apply(cases "convert_atom_list var L (xs' @ x # xs)") apply simp_all by (simp add: poly_to_univar) next case (Neq p) show ?thesis using Cons(2)[symmetric] Cons(1) Cons(3) unfolding Neq apply(cases " MPoly_Type.degree p var < 3") apply simp_all apply(cases "convert_atom_list var L (xs' @ x # xs)") apply simp_all by (simp add: poly_to_univar) qed qed lemma all_degree_2_convert : assumes "all_degree_2 var L" shows "∃L'. convert_atom_list var L xs = Some L'" using assms proof(induction L) case Nil then show ?case by auto next case (Cons a L) then show ?case proof(cases a) case (Less p) show ?thesis using Cons unfolding Less all_degree_2.simps convert_atom_list.simps convert_atom.simps using degree_convert_eq[of var p xs] by auto next case (Eq p) then show ?thesis using Cons unfolding Eq all_degree_2.simps convert_atom_list.simps convert_atom.simps using degree_convert_eq[of var p xs] by auto next case (Leq x3) then show ?thesis using Cons by auto next case (Neq x4) then show ?thesis using Cons by auto qed qed lemma gen_qe_eval : assumes hlength : "length xs = var" shows "(∃x. (eval (list_conj ((map Atom L) @ F)) (xs @ (x#Γ)))) = (∃x.(eval (gen_qe var L F) (xs @ (x#Γ))))" proof(cases "luckyFind var L []") case None then have notLucky : "luckyFind var L [] = None" by auto then show ?thesis proof(cases F) case Nil then show ?thesis proof(cases "all_degree_2 var L") case True then have "⋀x.∃L'. convert_atom_list var L (xs@x#Γ) = Some L'" using all_degree_2_convert[of var L "xs@_#Γ"] by auto then obtain L' where L' : "convert_atom_list var L (xs@x#Γ) = Some L'" by metis then have L' : "⋀x. convert_atom_list var L (xs@x#Γ) = Some L'" by (metis convert_atom_list_change hlength) show ?thesis unfolding Nil apply (simp add:eval_list_conj eval_list_disj True del:luckyFind.simps) unfolding notLucky apply (simp add:eval_list_conj eval_list_disj) using negInf_convert[OF L' assms] elimVar_atom_convert[OF L' L' assms] eval_convert[OF L' assms] using eval_generalVS''[of L'] unfolding eval_list_conj_Uni generalVS_DNF.simps eval_list_conj_Uni eval_list_disj_Uni eval_append eval_map eval_map_all evalUni.simps by auto next case False then show ?thesis using notLucky unfolding Nil False apply simp by (metis append_Nil2 hlength notLucky option.simps(4) qe_eq_repeat.simps qe_eq_repeat_eval) qed next case (Cons a list) show ?thesis apply(simp add:Cons del:qe_eq_repeat.simps) apply(rule qe_eq_repeat_eval[of xs var L "a # list" Γ]) using assms . qed next case (Some a) then show ?thesis using luckyFind_eval[OF Some assms] apply(cases F) apply simp apply(simp add:Cons del:qe_eq_repeat.simps) using qe_eq_repeat_eval[of xs var L _ Γ] using assms by auto qed lemma freeIn_elimVar : "freeIn var (elimVar var L F A)" proof(cases A) case (Less p) have two: "2 = Suc(Suc 0)" by auto have notIn4: "var ∉ vars (4::real mpoly)" by (metis isolate_var_one not_in_add not_in_isovarspar numeral_plus_numeral one_add_one semiring_norm(2) semiring_norm(6)) show ?thesis using Less apply auto using not_in_isovarspar apply force+ apply (rule freeIn_list_conj) apply auto defer defer using not_in_isovarspar apply force+ using not_in_sub[OF not_in_mult[of var 4, OF _ not_in_mult[of var "isolate_variable_sparse p var 2" "isolate_variable_sparse p var 0"]], of "(isolate_variable_sparse p var (Suc 0))⇧2"] apply (simp add:not_in_isovarspar two) using not_in_mult[of var "isolate_variable_sparse p var (Suc 0)" "isolate_variable_sparse p var (Suc 0)"] apply (simp add:not_in_isovarspar notIn4) apply (simp add: ideal.scale_scale) apply(rule freeIn_list_conj) apply auto defer defer apply(rule freeIn_list_conj) apply auto apply(rule freeIn_substInfinitesimalQuadratic) apply auto using not_in_isovarspar not_in_neg apply blast apply (metis not_in_isovarspar not_in_neg not_in_pow power_0) using notIn4 not_in_isovarspar not_in_mult not_in_pow not_in_sub apply auto[1] apply (metis isovarspar_sum mult_2 not_in_isovarspar) using freeIn_substInfinitesimalQuadratic_fm[of var "(- isolate_variable_sparse p var (Suc 0))" "-1" "((isolate_variable_sparse p var (Suc 0))⇧2 - 4 * isolate_variable_sparse p var 2 * isolate_variable_sparse p var 0)" "(2 * isolate_variable_sparse p var 2)"] apply auto[1] apply (metis (no_types, lifting) mult_2 notIn4 not_in_add not_in_isovarspar not_in_mult not_in_neg not_in_pow not_in_sub power_0) apply(rule freeIn_substInfinitesimalLinear) apply (meson not_in_isovarspar not_in_neg) apply (simp add: not_in_isovarspar) using freeIn_substInfinitesimalLinear_fm using not_in_isovarspar not_in_neg apply force apply (metis (no_types, lifting) ‹⟦var ∉ vars 4; var ∉ vars (isolate_variable_sparse p var 2); var ∉ vars (isolate_variable_sparse p var 0); var ∉ vars ((isolate_variable_sparse p var (Suc 0))⇧2)⟧ ⟹ var ∉ vars (4 * (isolate_variable_sparse p var 2 * isolate_variable_sparse p var 0) - (isolate_variable_sparse p var (Suc 0))⇧2)› freeIn_substInfinitesimalQuadratic minus_diff_eq mult.assoc mult_2 notIn4 not_in_add not_in_isovarspar not_in_neg not_in_pow power_0) using freeIn_substInfinitesimalQuadratic_fm[of var "(- isolate_variable_sparse p var (Suc 0))" 1 "((isolate_variable_sparse p var (Suc 0))⇧2 - 4 * isolate_variable_sparse p var 2 * isolate_variable_sparse p var 0)" "(2 * isolate_variable_sparse p var 2)"] apply auto by (metis (no_types, lifting) ‹⟦var ∉ vars 4; var ∉ vars (isolate_variable_sparse p var 2); var ∉ vars (isolate_variable_sparse p var 0); var ∉ vars ((isolate_variable_sparse p var (Suc 0))⇧2)⟧ ⟹ var ∉ vars (4 * (isolate_variable_sparse p var 2 * isolate_variable_sparse p var 0) - (isolate_variable_sparse p var (Suc 0))⇧2)› ideal.scale_scale minus_diff_eq mult_2 notIn4 not_in_add not_in_isovarspar not_in_neg not_in_pow power_0) next case (Eq p) then show ?thesis using freeIn_elimVar_eq by auto next case (Leq p) then show ?thesis using freeIn_elimVar_eq by auto next case (Neq p) have two: "2 = Suc(Suc 0)" by auto have notIn4: "var ∉ vars (4::real mpoly)" by (metis isolate_var_one not_in_add not_in_isovarspar numeral_plus_numeral one_add_one semiring_norm(2) semiring_norm(6)) show ?thesis using Neq apply auto using not_in_isovarspar apply force+ apply (rule freeIn_list_conj) apply auto defer defer using not_in_isovarspar apply force+ using not_in_sub[OF not_in_mult[of var 4, OF _ not_in_mult[of var "isolate_variable_sparse p var 2" "isolate_variable_sparse p var 0"]], of "(isolate_variable_sparse p var (Suc 0))⇧2"] apply (simp add:not_in_isovarspar two) using not_in_mult[of var "isolate_variable_sparse p var (Suc 0)" "isolate_variable_sparse p var (Suc 0)"] apply (simp add:not_in_isovarspar notIn4) apply (simp add: ideal.scale_scale) apply(rule freeIn_list_conj) apply auto defer defer apply(rule freeIn_list_conj) apply auto apply(rule freeIn_substInfinitesimalQuadratic) apply auto using not_in_isovarspar not_in_neg apply blast apply (metis not_in_isovarspar not_in_neg not_in_pow power_0) using notIn4 not_in_isovarspar not_in_mult not_in_pow not_in_sub apply auto[1] apply (metis isovarspar_sum mult_2 not_in_isovarspar) using freeIn_substInfinitesimalQuadratic_fm[of var "(- isolate_variable_sparse p var (Suc 0))" "-1" "((isolate_variable_sparse p var (Suc 0))⇧2 - 4 * isolate_variable_sparse p var 2 * isolate_variable_sparse p var 0)" "(2 * isolate_variable_sparse p var 2)"] apply auto[1] apply (metis (no_types, lifting) mult_2 notIn4 not_in_add not_in_isovarspar not_in_mult not_in_neg not_in_pow not_in_sub power_0) apply(rule freeIn_substInfinitesimalLinear) apply (meson not_in_isovarspar not_in_neg) apply (simp add: not_in_isovarspar) using freeIn_substInfinitesimalLinear_fm using not_in_isovarspar not_in_neg apply force apply (metis (no_types, lifting) ‹⟦var ∉ vars 4; var ∉ vars (isolate_variable_sparse p var 2); var ∉ vars (isolate_variable_sparse p var 0); var ∉ vars ((isolate_variable_sparse p var (Suc 0))⇧2)⟧ ⟹ var ∉ vars (4 * (isolate_variable_sparse p var 2 * isolate_variable_sparse p var 0) - (isolate_variable_sparse p var (Suc 0))⇧2)› freeIn_substInfinitesimalQuadratic minus_diff_eq mult.assoc mult_2 notIn4 not_in_add not_in_isovarspar not_in_neg not_in_pow power_0) using freeIn_substInfinitesimalQuadratic_fm[of var "(- isolate_variable_sparse p var (Suc 0))" 1 "((isolate_variable_sparse p var (Suc 0))⇧2 - 4 * isolate_variable_sparse p var 2 * isolate_variable_sparse p var 0)" "(2 * isolate_variable_sparse p var 2)"] apply auto by (metis (no_types, lifting) ‹⟦var ∉ vars 4; var ∉ vars (isolate_variable_sparse p var 2); var ∉ vars (isolate_variable_sparse p var 0); var ∉ vars ((isolate_variable_sparse p var (Suc 0))⇧2)⟧ ⟹ var ∉ vars (4 * (isolate_variable_sparse p var 2 * isolate_variable_sparse p var 0) - (isolate_variable_sparse p var (Suc 0))⇧2)› ideal.scale_scale minus_diff_eq mult_2 notIn4 not_in_add not_in_isovarspar not_in_neg not_in_pow power_0) qed lemma freeInDisj: "freeIn var (list_disj (list_conj (map (substNegInfinity var) L) # map (elimVar var L []) L))" apply(rule freeIn_list_disj) apply(auto) apply(rule freeIn_list_conj) apply simp using freeIn_substNegInfinity[of var] apply simp using freeIn_elimVar by simp lemma gen_qe_eval' : assumes "all_degree_2 var L" assumes "length xs' = var" shows "(∃x. (eval (list_conj (map Atom L)) (xs'@x#Γ))) = (∀x.(eval (gen_qe var L []) (xs'@x#Γ)))" "freeIn var (gen_qe var L [])" proof- have h : "(∃x. (eval (list_conj (map Atom L)) (xs'@x#Γ))) = (∃x. eval (gen_qe var L []) (xs'@x # Γ))" using gen_qe_eval[OF assms(2), of L "[]" Γ] unfolding List.append.left_neutral by auto show "(∃x. (eval (list_conj (map Atom L)) (xs'@x#Γ))) = (∀x.(eval (gen_qe var L []) (xs'@x#Γ)))" unfolding h apply (simp add:assms) apply(cases "find_lucky_eq var L") apply simp using freeInDisj[of var L] using var_not_in_eval3[OF _ assms(2)] apply blast subgoal for a using freeIn_elimVar_eq[of var L "[]" a] apply(simp del:elimVar.simps) using var_not_in_eval3[OF _ assms(2)] by blast done next show "freeIn var (gen_qe var L []) " apply(simp add:assms) apply(cases "find_lucky_eq var L") apply (simp add:freeInDisj) subgoal for a using freeIn_elimVar_eq[of var L "[]" a] by(simp del:elimVar.simps) done qed lemma gen_qe_eval'' : assumes "all_degree_2 var L" assumes "length xs' = var" shows "(∃x. (eval (list_conj (map Atom L)) (xs'@x#Γ))) = (∀x.(eval (list_disj (list_conj (map (substNegInfinity var) L) # map (elimVar var L []) L)) (xs'@x#Γ)))" proof(cases "convert_atom_list var L (xs'@x#Γ)") case None then show ?thesis using all_degree_2_convert[OF assms(1), of "(xs' @ x # Γ)"] by auto next case (Some a) then have Some : "⋀x. convert_atom_list var L (xs'@x#Γ) = Some a" using convert_atom_list_change[OF assms(2), of L x Γ] by fastforce show ?thesis apply (simp add: eval_list_conj eval_list_disj) using negInf_convert[OF Some assms(2)] elimVar_atom_convert[OF Some Some assms(2)] eval_convert[OF Some assms(2)] using eval_generalVS''[of a] unfolding eval_list_conj_Uni generalVS_DNF.simps eval_list_conj_Uni eval_list_disj_Uni eval_append eval_map eval_map_all evalUni.simps by auto qed end
section "QE Algorithm Proofs" subsection "DNF" theory DNF imports VSAlgos begin theorem dnf_eval : "(∃(al,fl)∈set (dnf φ). (∀a∈set al. aEval a xs) ∧ (∀f∈set fl. eval f xs)) = eval φ xs" proof(induction φ) case (And φ1 φ2) define f where "f = (λa. case a of (al, fl) ⇒ (∀a∈set al. aEval a xs) ∧ (∀f∈set fl. eval f xs))" have h1:"(∃a∈set (dnf (And φ1 φ2)). f a) = (∃a∈set (dnf φ1). ∃a'∈set(dnf φ2). f a ∧ f a')" apply simp unfolding f_def apply auto apply blast apply blast subgoal for a b c d apply(rule bexI[where x="(a,b)"]) apply(rule exI[where x="a@c"]) apply(rule exI[where x="b@d"]) by auto done also have h2 : "... = ((∃a∈set (dnf φ1). f a)∧(∃a∈set(dnf φ2). f a))" by auto show ?case unfolding f_def[symmetric] unfolding h1 h2 unfolding f_def using And by auto qed auto theorem dnf_modified_eval : "(∃(al,fl,n)∈set (dnf_modified φ). (∃L. (length L = n ∧ (∀a∈set al. aEval a (L@xs)) ∧ (∀f∈set fl. eval f (L@xs))))) = eval φ xs" proof(induction φ arbitrary:xs) case (Atom x) then show ?case by (cases x, auto) next case (And φ1 φ2) {fix d1 d2 A A' B B' L1 L2 assume A : "(A,A',length (L1::real list))∈set (dnf_modified φ1)" and "(B,B',length (L2::real list))∈set (dnf_modified φ2)" have "( (∀a∈set ((map (liftAtom (length L1) (length L2)) A @ map (liftAtom 0 (length L1)) B)). aEval a ((L1@L2) @ xs)) ∧ (∀f∈set ( map (liftFm (length L1) (length L2)) A' @ map (liftFm 0 (length L1)) B'). eval f ((L1@L2) @ xs))) = ( (∀a∈set(map (liftAtom (length L1) (length L2)) A) ∪ set( map (liftAtom 0 (length L1)) B). aEval a ((L1@L2) @ xs)) ∧ (∀f∈set( map (liftFm (length L1) (length L2)) A') ∪ set(map (liftFm 0 (length L1)) B'). eval f ((L1@L2) @ xs)))" by auto also have "... = ( (∀a∈set(map (liftAtom (length L1) (length L2)) A).aEval a ((L1@L2) @ xs)) ∧ (∀a∈set(map (liftAtom 0 (length L1)) B). aEval a ((L1@L2) @ xs)) ∧ (∀f∈set(map (liftFm (length L1) (length L2)) A').eval f ((L1@L2) @ xs)) ∧ (∀f∈set(map (liftFm 0 (length L1)) B'). eval f ((L1@L2) @ xs)))" by blast also have "... = ( (∀a∈set A. aEval (liftAtom (length L1) (length L2) a) ((L1@L2) @ xs)) ∧ (∀a∈set B. aEval (liftAtom 0 (length L1) a) ((L1@L2) @ xs)) ∧ (∀f∈set A'. eval (liftFm (length L1) (length L2) f) ((L1@L2) @ xs)) ∧ (∀f∈set B'. eval (liftFm 0 (length L1) f) ((L1@L2) @ xs)))" by simp also have "... = ( (∀a∈set A. aEval (liftAtom (length L1) (length L2) a) (insert_into (L1 @ xs) (length L1) L2)) ∧ (∀a∈set B. aEval (liftAtom 0 (length L1) a) (insert_into (L2 @ xs) 0 L1)) ∧ (∀f∈set A'. eval (liftFm (length L1) (length L2) f) (insert_into (L1 @ xs) (length L1) L2)) ∧ (∀f∈set B'. eval (liftFm 0 (length L1) f) (insert_into (L2 @ xs) 0 L1)))" by auto also have "... = ( ((∀a∈set A. aEval a (L1 @ xs)) ∧ (∀f∈set A'. eval f (L1 @ xs))) ∧ ((∀a∈set B. aEval a (L2 @ xs)) ∧ (∀f∈set B'. eval f (L2 @ xs))) )" proof safe fix a show "∀a∈set A. aEval (liftAtom (length L1) (length L2) a) (insert_into (L1 @ xs) (length L1) L2) ⟹ a ∈ set A ⟹ aEval a (L1 @ xs)" using eval_liftFm[of L2 "length L2" "length L1" "L1 @ xs" "Atom a", OF refl] by auto next fix f show "∀f∈set A'. eval (liftFm (length L1) (length L2) f) (insert_into (L1 @ xs) (length L1) L2) ⟹ f ∈ set A' ⟹ eval f (L1 @ xs)" using eval_liftFm[of L2 "length L2" "length L1" "L1 @ xs" f, OF refl] by auto next fix a show " ∀a∈set B. aEval (liftAtom 0 (length L1) a) (insert_into (L2 @ xs) 0 L1) ⟹ a ∈ set B ⟹ aEval a (L2 @ xs)" using eval_liftFm[of L1 "length L1" "0" "L2@xs" "Atom a", OF refl] by auto next fix f show " ∀f∈set B'. eval (liftFm 0 (length L1) f) (insert_into (L2 @ xs) 0 L1) ⟹ f ∈ set B' ⟹ eval f (L2 @ xs)" using eval_liftFm[of L1 "length L1" "0" "L2 @ xs" f, OF refl] by auto next fix a show " ∀a∈set A. aEval a (L1 @ xs) ⟹ a ∈ set A ⟹ aEval (liftAtom (length L1) (length L2) a) (insert_into (L1 @ xs) (length L1) L2)" using eval_liftFm[of L2 "length L2" "length L1" "L1 @ xs" "Atom a", OF refl] by auto next fix a show "∀a∈set B. aEval a (L2 @ xs) ⟹ a ∈ set B ⟹ aEval (liftAtom 0 (length L1) a) (insert_into (L2 @ xs) 0 L1)" using eval_liftFm[of L1 "length L1" "0" "L2@xs" "Atom a", OF refl] by auto next fix f show "∀f∈set A'. eval f (L1 @ xs) ⟹ f ∈ set A' ⟹ eval (liftFm (length L1) (length L2) f) (insert_into (L1 @ xs) (length L1) L2)" using eval_liftFm[of L2 "length L2" "length L1" "L1 @ xs" f, OF refl] by auto next fix f show "∀f∈set B'. eval f (L2 @ xs) ⟹ f ∈ set B' ⟹ eval (liftFm 0 (length L1) f) (insert_into (L2 @ xs) 0 L1)" using eval_liftFm[of L1 "length L1" "0" "L2 @ xs" f, OF refl] by auto qed finally have "( (∀a∈set ((map (liftAtom (length L1) (length L2)) A @ map (liftAtom 0 (length L1)) B)). aEval a ((L1@L2) @ xs)) ∧ (∀f∈set ( map (liftFm (length L1) (length L2)) A' @ map (liftFm 0 (length L1)) B'). eval f ((L1@L2) @ xs))) = ( ((∀a∈set A. aEval a (L1 @ xs)) ∧ (∀f∈set A'. eval f (L1 @ xs))) ∧ ((∀a∈set B. aEval a (L2 @ xs)) ∧ (∀f∈set B'. eval f (L2 @ xs))) )" by simp } then have h : "(∃(A,A',d1)∈set (dnf_modified φ1). ∃(B,B',d2)∈set (dnf_modified φ2). (∃L1.∃L2. length L1 = d1 ∧ length L2 = d2 ∧ (∀a∈set ((map (liftAtom d1 d2) A @ map (liftAtom 0 d1) B)). aEval a ((L1@L2) @ xs)) ∧ (∀f∈set ( map (liftFm d1 d2) A' @ map (liftFm 0 d1) B'). eval f ((L1@L2) @ xs)))) = ((∃(A,A',d1)∈set (dnf_modified φ1). ∃(B,B',d2)∈set(dnf_modified φ2). (∃L1. length L1 = d1 ∧ (∀a∈set A. aEval a (L1 @ xs)) ∧ (∀f∈set A'. eval f (L1 @ xs))) ∧ (∃L2. length L2 = d2 ∧ (∀a∈set B. aEval a (L2 @ xs)) ∧ (∀f∈set B'. eval f (L2 @ xs))) ))" proof safe fix A A' B B' L1 L2 assume prev : "(⋀A A' L1 B B' L2. (A, A', length L1) ∈ set (dnf_modified φ1) ⟹ (B, B', length L2) ∈ set (dnf_modified φ2) ⟹ ((∀a∈set (map (liftAtom (length L1) (length L2)) A @ map (liftAtom 0 (length L1)) B). aEval a ((L1 @ L2) @ xs)) ∧ (∀f∈set (map (liftFm (length L1) (length L2)) A' @ map (liftFm 0 (length L1)) B'). eval f ((L1 @ L2) @ xs))) = (((∀a∈set A. aEval a (L1 @ xs)) ∧ (∀f∈set A'. eval f (L1 @ xs))) ∧ (∀a∈set B. aEval a (L2 @ xs)) ∧ (∀f∈set B'. eval f (L2 @ xs))))" and A: "(A,A',length L1)∈set (dnf_modified φ1)" and B: "(B,B',length L2)∈set (dnf_modified φ2)" and h1 : "∀a∈set (map (liftAtom (length L1) (length L2)) A @ map (liftAtom 0 (length L1)) B). aEval a ((L1 @ L2) @ xs)" and h2 : "∀f∈set (map (liftFm (length L1) (length L2)) A' @ map (liftFm 0 (length L1)) B'). eval f ((L1 @ L2) @ xs)" have h : "((∀a∈set (map (liftAtom (length L1) (length L2)) A @ map (liftAtom 0 (length L1)) B). aEval a ((L1 @ L2) @ xs)) ∧ (∀f∈set (map (liftFm (length L1) (length L2)) A' @ map (liftFm 0 (length L1)) B'). eval f ((L1 @ L2) @ xs))) = (((∀a∈set A. aEval a (L1 @ xs)) ∧ (∀f∈set A'. eval f (L1 @ xs))) ∧ (∀a∈set B. aEval a (L2 @ xs)) ∧ (∀f∈set B'. eval f (L2 @ xs)))" using prev[where A="A", where A'="A'", where B="B", where B'="B'"] A B by simp show "∃(A, A', d1)∈set (dnf_modified φ1). ∃(B, B', d2)∈set (dnf_modified φ2). (∃L1. length L1 = d1 ∧ (∀a∈set A. aEval a (L1 @ xs)) ∧ (∀f∈set A'. eval f (L1 @ xs))) ∧ (∃L2. length L2 = d2 ∧ (∀a∈set B. aEval a (L2 @ xs)) ∧ (∀f∈set B'. eval f (L2 @ xs)))" apply (rule bexI[where x="(A, A', length L1)", OF _ A]) apply auto defer apply (rule bexI[where x="(B, B', length L2)", OF _ B]) apply auto using h h1 h2 by auto next fix A A' d1 B B' d2 L1 L2 assume prev : "(⋀A A' L1 B B' L2. (A, A', length L1) ∈ set (dnf_modified φ1) ⟹ (B, B', length L2) ∈ set (dnf_modified φ2) ⟹ ((∀a∈set (map (liftAtom (length L1) (length L2)) A @ map (liftAtom 0 (length L1)) B). aEval a ((L1 @ L2) @ xs)) ∧ (∀f∈set (map (liftFm (length L1) (length L2)) A' @ map (liftFm 0 (length L1)) B'). eval f ((L1 @ L2) @ xs))) = (((∀a∈set A. aEval a (L1 @ xs)) ∧ (∀f∈set A'. eval f (L1 @ xs))) ∧ (∀a∈set B. aEval a (L2 @ xs)) ∧ (∀f∈set B'. eval f (L2 @ xs))))" and A: "(A,A',length L1)∈set (dnf_modified φ1)" and B: "(B,B',length L2)∈set (dnf_modified φ2)" and h1 : "∀a∈set A. aEval a (L1 @ xs)" "∀f∈set A'. eval f (L1 @ xs)" "∀a∈set B. aEval a (L2 @ xs)" "∀f∈set B'. eval f (L2 @ xs)" have h : "((∀a∈set (map (liftAtom (length L1) (length L2)) A @ map (liftAtom 0 (length L1)) B). aEval a ((L1 @ L2) @ xs)) ∧ (∀f∈set (map (liftFm (length L1) (length L2)) A' @ map (liftFm 0 (length L1)) B'). eval f ((L1 @ L2) @ xs))) = (((∀a∈set A. aEval a (L1 @ xs)) ∧ (∀f∈set A'. eval f (L1 @ xs))) ∧ (∀a∈set B. aEval a (L2 @ xs)) ∧ (∀f∈set B'. eval f (L2 @ xs)))" using prev[where A="A", where A'="A'", where B="B", where B'="B'"] h1 A B by simp show "∃(A, A', d1)∈set (dnf_modified φ1). ∃(B, B', d2)∈set (dnf_modified φ2). ∃L1 L2. length L1 = d1 ∧ length L2 = d2 ∧ (∀a∈set (map (liftAtom d1 d2) A @ map (liftAtom 0 d1) B). aEval a ((L1 @ L2) @ xs)) ∧ (∀f∈set (map (liftFm d1 d2) A' @ map (liftFm 0 d1) B'). eval f ((L1 @ L2) @ xs))" apply (rule bexI[where x="(A, A', length L1)", OF _ A]) apply auto defer apply (rule bexI[where x="(B, B', length L2)", OF _ B]) apply auto apply (rule exI[where x="L1"]) apply auto apply (rule exI[where x="L2"]) apply auto using h h1 by auto qed define f where "f (x:: (atom list * atom fm list * nat)) = (case x of (al,fl,n) ⇒ (∃L. length L = n ∧ (∀a∈set al. aEval a (L @ xs)) ∧ (∀f∈set fl. eval f (L @ xs))))" for x define g where "((g (uuaa::atom list) (uua::atom fm list) (uu::nat) x):: (atom list * atom fm list * nat)) = ( case x of (B, B', d2) ⇒ (map (liftAtom uu d2) uuaa @ map (liftAtom 0 uu) B, map (λx. map_fm_binders (λa x. liftAtom (uu + x) d2 a) x 0) uua @ map (λx. map_fm_binders (λa x. liftAtom (0 + x) uu a) x 0) B', uu + d2))" for uuaa uua uu x define f' where "f' L A A' d1 B B' d2 = ((∀a∈set ((map (liftAtom d1 d2) A @ map (liftAtom 0 d1) B)). aEval a (L @ xs)) ∧ (∀f∈set ( map (liftFm d1 d2) A' @ map (liftFm 0 d1) B'). eval f (L @ xs)))" for L A A' d1 B B' d2 have "(∃(al, fl, n)∈set (dnf_modified (And φ1 φ2)). ∃L. length L = n ∧ (∀a∈set al. aEval a (L @ xs)) ∧ (∀f∈set fl. eval f (L @ xs))) = (∃y∈set (dnf_modified (And φ1 φ2)). f y)" unfolding f_def by simp also have "... = (∃y∈set (dnf_modified φ1). ∃a aa b. (∃uu uua uuaa. (uuaa, uua, uu) = y ∧ (a, aa, b) ∈ (g uuaa uua uu) ` set (dnf_modified φ2)) ∧ f (a, aa, b))" using g_def by simp also have "... = (∃(A,A',d1)∈set (dnf_modified φ1). ∃x∈set (dnf_modified φ2). f (g A A' d1 x))" by (smt case_prodE f_def imageE image_eqI prod.simps(2)) also have "... = (∃(A,A',d1)∈set (dnf_modified φ1). ∃x∈set (dnf_modified φ2). f (case x of (B,B',d2) ⇒ (map (liftAtom d1 d2) A @ map (liftAtom 0 d1) B, map (λx. liftFm d1 d2 x) A' @ map (λx. liftFm 0 d1 x) B', d1 + d2)))" using g_def by simp also have "... = (∃(A,A',d1)∈set (dnf_modified φ1). ∃x∈set (dnf_modified φ2). (case (case x of (B,B',d2) ⇒ (map (liftAtom d1 d2) A @ map (liftAtom 0 d1) B, map (λx. liftFm d1 d2 x) A' @ map (λx. liftFm 0 d1 x) B', d1 + d2)) of (al,fl,n) ⇒ (∃L. length L = n ∧ (∀a∈set al. aEval a (L @ xs)) ∧ (∀f∈set fl. eval f (L @ xs)))) )" using f_def by simp also have "... = (∃(A,A',d1)∈set (dnf_modified φ1). ∃(B,B',d2)∈set (dnf_modified φ2). (case ((map (liftAtom d1 d2) A @ map (liftAtom 0 d1) B, map (λx. liftFm d1 d2 x) A' @ map (λx. liftFm 0 d1 x) B', d1 + d2)) of (al,fl,n) ⇒ (∃L. length L = n ∧ (∀a∈set al. aEval a (L @ xs)) ∧ (∀f∈set fl. eval f (L @ xs)))) )" by(smt case_prodE case_prodE2 old.prod.case) also have "... = (∃(A,A',d1)∈set (dnf_modified φ1). ∃(B,B',d2)∈set (dnf_modified φ2). (∃L. length L = d1 + d2 ∧ (∀a∈set ((map (liftAtom d1 d2) A @ map (liftAtom 0 d1) B)). aEval a (L @ xs)) ∧ (∀f∈set ( map (liftFm d1 d2) A' @ map (liftFm 0 d1) B'). eval f (L @ xs))))" by(smt case_prodE case_prodE2 old.prod.case) also have "... = (∃(A,A',d1)∈set (dnf_modified φ1). ∃(B,B',d2)∈set (dnf_modified φ2). (∃L. length L = d1 + d2 ∧ (f' L A A' d1 B B' d2)))" using f'_def by simp also have "... = (∃(A,A',d1)∈set (dnf_modified φ1). ∃(B,B',d2)∈set (dnf_modified φ2). (∃L1.∃L2. length L1 = d1 ∧ length L2 = d2 ∧ (f' (L1@L2) A A' d1 B B' d2)))" proof safe fix A A' d1 B B' d2 L assume A: "(A,A',d1)∈set (dnf_modified φ1)" and B: "(B,B',d2)∈set (dnf_modified φ2)" and L: "length L = d1 + d2" "(f' L A A' d1 B B' d2)" show "∃(A, A', d1)∈set (dnf_modified φ1). ∃(B, B', d2)∈set (dnf_modified φ2). ∃L1 L2. length L1 = d1 ∧ length L2 = d2 ∧ f' (L1 @ L2) A A' d1 B B' d2" apply (rule bexI[where x="(A, A', d1)", OF _ A]) apply auto apply (rule bexI[where x="(B, B', d2)", OF _ B]) apply auto apply (rule exI[where x="take d1 L"]) apply auto defer apply (rule exI[where x="drop d1 L"]) using L by auto next fix A A' d1 B B' d2 L1 L2 assume A: "(A,A', length L1)∈set (dnf_modified φ1)" and B: "(B,B',length L2)∈set (dnf_modified φ2)" and L: "(f' (L1 @ L2) A A' (length L1) B B' (length L2))" thm exI thm bexI show "∃(A, A', d1)∈set (dnf_modified φ1). ∃(B, B', d2)∈set (dnf_modified φ2). ∃L. length L = d1 + d2 ∧ f' L A A' d1 B B' d2 " apply (rule bexI[where x="(A, A', length L1)", OF _ A]) apply auto apply (rule bexI[where x="(B, B', length L2)", OF _ B]) apply auto apply (rule exI[where x="L1 @ L2"]) using L by auto qed also have "... = (∃(A,A',d1)∈set (dnf_modified φ1). ∃(B,B',d2)∈set (dnf_modified φ2). (∃L1.∃L2. length L1 = d1 ∧ length L2 = d2 ∧ (∀a∈set ((map (liftAtom d1 d2) A @ map (liftAtom 0 d1) B)). aEval a ((L1@L2) @ xs)) ∧ (∀f∈set ( map (liftFm d1 d2) A' @ map (liftFm 0 d1) B'). eval f ((L1@L2) @ xs))))" unfolding f'_def by simp (*also have "... = (∃(A,A',d1)∈set (dnf_modified φ1). ∃(B,B',d2)∈set (dnf_modified φ2). (∃L1.∃L2. length L1 = d1 ∧ length L2 = d2 ∧ (∀a∈set (map (liftAtom d1 d2) A) ∪ set ( map (liftAtom 0 d1) B). aEval a ((L1@L2) @ xs)) ∧ (∀f∈set ( map (liftFm d1 d2) A' @ map (liftFm 0 d1) B'). eval f ((L1@L2) @ xs))))" proof - have *: "(∀a∈set (map (liftAtom d1 d2) A @ map (liftAtom 0 d1) B). aEval a ((L1 @ L2) @ xs)) = (∀a∈set (map (liftAtom d1 d2) A) ∪ set ( map (liftAtom 0 d1) B). aEval a ((L1@L2) @ xs))" for d1 d2 A B L1 L2 by auto then show ?thesis apply (subst * ) .. qed (* apply (rule bex_cong[OF refl]) unfolding split_beta apply (rule bex_cong[OF refl]) apply (rule ex_cong1)+ apply (rule conj_cong refl)+ by auto *) *) also have "... = ((∃(A,A',d1)∈set (dnf_modified φ1). ∃(B,B',d2)∈set(dnf_modified φ2). (∃L. length L = d1 ∧ (∀a∈set A. aEval a (L @ xs)) ∧ (∀f∈set A'. eval f (L @ xs))) ∧ (∃L. length L = d2 ∧ (∀a∈set B. aEval a (L @ xs)) ∧ (∀f∈set B'. eval f (L @ xs))) ))" using h by simp also have "... = ((∃(A,A',d1)∈set (dnf_modified φ1). ∃(B,B',d2)∈set(dnf_modified φ2). f (A,A',d1) ∧ f (B,B',d2)))" using f_def by simp also have "... = ((∃a∈set (dnf_modified φ1). ∃a1∈set(dnf_modified φ2). f a ∧ f a1))" by (simp add: Bex_def_raw) also have "... = ((∃a∈set (dnf_modified φ1). f a) ∧ (∃a∈set (dnf_modified φ2). f a))" by blast also have "... = eval (And φ1 φ2) xs" using And f_def by simp finally have "(∃(al, fl, n)∈set (dnf_modified (And φ1 φ2)). ∃L. length L = n ∧ (∀a∈set al. aEval a (L @ xs)) ∧ (∀f∈set fl. eval f (L @ xs))) = eval (And φ1 φ2) xs" by simp then show ?case by simp next case (Or φ1 φ2) have h1 : "eval (Or φ1 φ2) xs = eval φ1 xs ∨ eval φ2 xs" using eval.simps(5) by blast have h2 : "set (dnf_modified (Or φ1 φ2)) = set(dnf_modified φ1) ∪ set(dnf_modified φ2)" by simp show ?case using Or h1 h2 by (metis (no_types, lifting) Un_iff eval.simps(5)) next case (ExQ φ) have h1 : "((∃x. (∃(al, fl, n)∈set (dnf_modified φ). ∃L. length L = n ∧ (∀a∈set al. aEval a (L @ (x#xs))) ∧ (∀f∈set fl. eval f (L @ (x#xs))))) = (∃(al, fl, n)∈set (dnf_modified φ). (∃x.∃L. length L = n ∧ (∀a∈set al. aEval a ((L@[x]) @ xs)) ∧ (∀f∈set fl. eval f ((L@[x]) @ xs)))))" apply simp by blast { fix n al fl define f where "f L = (length (L:: real list) = ((n::nat)+1) ∧ (∀a∈set al. aEval a (L @ xs)) ∧ (∀f∈set fl. eval f (L @ xs)))" for L have "(∃x.∃L. f (L@[x])) = (∃L. f L)" by (metis (full_types) One_nat_def add_Suc_right f_def list.size(3) nat.simps(3) rev_exhaust) then have "((∃x. ∃L. length (L@[x]) = (n+1) ∧ (∀a∈set al. aEval a ((L@[x]) @ xs)) ∧ (∀f∈set fl. eval f ((L@[x]) @ xs))) = (∃L. length L = (n+1) ∧ (∀a∈set al. aEval a (L @ xs)) ∧ (∀f∈set fl. eval f (L @ xs))))" unfolding f_def by simp } then have h2 : "∀n al fl. ( (∃x. ∃L. length (L@[x]) = (n+1) ∧ (∀a∈set al. aEval a ((L@[x]) @ xs)) ∧ (∀f∈set fl. eval f ((L@[x]) @ xs))) = (∃L. length L = (n+1) ∧ (∀a∈set al. aEval a (L @ xs)) ∧ (∀f∈set fl. eval f (L @ xs))) )" by simp { fix al fl n define f where "f al fl n = (∃L. length L = n ∧ (∀a∈set al. aEval a (L @ xs)) ∧ (∀f∈set fl. eval f (L @ xs)))" for al fl n have "f al fl (n+1) = (case (case (al, fl, n) of (A, A', d) ⇒ (A, A',d+1)) of (al, fl, n) ⇒ f al fl n)" by simp then have "(∃L. length L = (n+1) ∧ (∀a∈set al. aEval a (L @ xs)) ∧ (∀f∈set fl. eval f (L @ xs))) = ( case (case (al, fl, n) of (A, A', d) ⇒ (A, A',d+1)) of (al, fl, n) ⇒ ∃L. length L = n ∧ (∀a∈set al. aEval a (L @ xs)) ∧ (∀f∈set fl. eval f (L @ xs)))" unfolding f_def by simp } then have h3 : " (∃(al, fl, n)∈set (dnf_modified φ). ∃L. length L = (n+1) ∧ (∀a∈set al. aEval a (L @ xs)) ∧ (∀f∈set fl. eval f (L @ xs))) = (∃a∈set (dnf_modified φ). case (case a of (A, A', d) ⇒ (A, A',d+1)) of (al, fl, n) ⇒ ∃L. length L = n ∧ (∀a∈set al. aEval a (L @ xs)) ∧ (∀f∈set fl. eval f (L @ xs)))" by (smt case_prodE case_prodI2) (* takes a second *) show ?case using ExQ h1 h2 h3 by simp next case (ExN x1 φ) show ?case apply simp proof safe fix a aa b L have takedrop: "(take b L @ drop b L @ xs) = (L @ xs)" by auto assume h: "(a, aa, b) ∈ set (dnf_modified φ)" "length L = b + x1" "∀a∈set a. aEval a (L @ xs)" "∀f∈set aa. eval f (L @ xs)" show "∃l. length l = x1 ∧ eval φ (l @ xs)" apply(rule exI[where x="drop b L"]) apply auto using h(2) apply simp unfolding ExN[symmetric] apply(rule bexI[where x="(a,aa,b)"]) apply simp apply(rule exI[where x="take b L"]) apply auto using h apply simp unfolding takedrop using h by auto next fix l assume h: "eval φ (l @ xs)" "x1 = length l" obtain al fl n where h1 : "(al, fl, n)∈set (dnf_modified φ)" "∃L. length L = n ∧ (∀a∈set al. aEval a (L @ l @ xs)) ∧ (∀f∈set fl. eval f (L @ l @ xs))" using h(1) unfolding ExN[symmetric] by blast obtain L where h2 : "length L = n" "(∀a∈set al. aEval a (L @ l @ xs))" "(∀f∈set fl. eval f (L @ l @ xs))" using h1(2) by metis show "∃x∈set (dnf_modified φ). case case x of (A, A', d) ⇒ (A, A', d + length l) of (al, fl, n) ⇒ ∃L. length L = n ∧ (∀a∈set al. aEval a (L @ xs)) ∧ (∀f∈set fl. eval f (L @ xs))" apply(rule bexI[where x="(al,fl,n)"]) apply simp apply(rule exI[where x="L@l"]) apply auto using h2 h1 by auto qed qed auto end
subsection "Recursive QE" theory VSQuad imports EqualityVS GeneralVSProofs Reindex OptimizationProofs DNF begin lemma existN_eval : "∀xs. eval (ExN n φ) xs = (∃L. (length L = n ∧ eval φ (L@xs)))" proof(induction n) case 0 then show ?case by simp next case (Suc n) {fix xs have "eval (ExN (Suc n) φ) xs = (∃l. length l = Suc n ∧ eval φ (l @ xs))" by simp also have "... = (∃x.∃L. (length L = n ∧ eval φ (L@(x#xs))))" proof safe fix l assume h : "length l = Suc n" "eval φ (l @ xs)" show "∃x L. length L = n ∧ eval φ (L @ x # xs)" apply(rule exI[where x="l ! n"]) apply(rule exI[where x="take n l"]) using h apply auto by (metis Cons_nth_drop_Suc append.assoc append_Cons append_take_drop_id lessI order_refl self_append_conv self_append_conv2 take_all) next fix x L assume h : "eval φ (L @ x # xs)" "n = length L" show "∃l. length l = Suc (length L) ∧ eval φ (l @ xs)" apply(rule exI[where x="L@[x]"]) using h by auto qed also have "... = (∃x.∃L. (length L = n ∧ eval φ ((L@[x])@xs)))" by simp also have "... = (∃x.∃L. (length (L@[x]) = (Suc n) ∧ eval φ ((L@[x])@xs)))" by simp also have "... = (∃L. (length L = (Suc n) ∧ eval φ (L@xs)))" by (metis append_butlast_last_id length_0_conv nat.simps(3)) finally have "eval (ExN (Suc n) φ) xs = (∃L. (length L = (Suc n) ∧ eval φ (L@xs)))" by simp } then show ?case by simp qed lemma boundedFlipNegQuantifier : "(¬(∀x∈A. ¬ P x)) = (∃x∈A. P x)" by blast theorem QE_dnf'_eval: assumes steph : "⋀amount F Γ. (∃xs. (length xs = amount ∧ eval (list_disj (map(λ(L,F,n). ExN n (list_conj (map fm.Atom L @ F))) F)) (xs @ Γ))) = (eval (step amount F) Γ)" assumes opt : "⋀xs F . eval (opt F) xs = eval F xs" shows "eval (QE_dnf' opt step φ) xs = eval φ xs" proof(induction φ arbitrary : xs) case (Atom x) then show ?case by (simp add: simp_atom_eval) next case (And φ1 φ2) then show ?case by (simp add: eval_and) next case (Or φ1 φ2) then show ?case by (simp add: eval_or) next case (Neg φ) then show ?case apply simp by (metis eval_neg ) next case (ExQ φ) have h1 : "⋀F. (∃xs. length xs = Suc 0 ∧ F xs) = (∃x. F [x])" by (metis length_0_conv length_Suc_conv) show ?case apply simp unfolding steph[symmetric] apply(simp add: eval_list_disj) unfolding h1 apply(rule ex_cong1) unfolding ExQ[symmetric] unfolding opt[symmetric, of "(QE_dnf' opt step φ)"] unfolding dnf_modified_eval[symmetric, of "(opt (QE_dnf' opt step φ))"] apply(rule bex_cong) apply simp subgoal for x f apply(cases f) apply (auto simp add:eval_list_conj) by (metis Un_iff eval.simps(1) imageI) done next case (AllQ φ) have h1 : "⋀F. (∀xs::real list. (length xs = Suc 0 ⟶ F xs)) = (∀x. F [x])" by (metis length_0_conv length_Suc_conv) show ?case apply simp unfolding steph[symmetric] apply(simp add: eval_list_disj) unfolding h1 apply(rule all_cong1) unfolding AllQ[symmetric] unfolding eval_neg[symmetric, of "(QE_dnf' opt step φ)"] unfolding opt[symmetric, of "neg(QE_dnf' opt step φ)"] unfolding Set.bex_simps(8)[symmetric] HOL.Not_eq_iff unfolding dnf_modified_eval[symmetric, of "(opt (neg(QE_dnf' opt step φ)))"] apply(rule bex_cong) apply simp subgoal for x f apply(cases f) apply (auto simp add:eval_list_conj) by (metis Un_iff eval.simps(1) imageI) done next case (ExN amount φ) show ?case apply(cases amount) apply (simp_all add: ExN) unfolding steph[symmetric] apply(simp add: eval_list_disj) unfolding ExN[symmetric] unfolding opt[of "(QE_dnf' opt step φ)",symmetric] unfolding dnf_modified_eval[of "(opt (QE_dnf' opt step φ))",symmetric] apply(rule ex_cong1) subgoal for nat xs apply(cases "length xs = Suc nat") apply simp_all apply(rule bex_cong) apply simp_all subgoal for f apply(cases f) apply simp apply(rule ex_cong1) unfolding eval_list_conj apply auto by (meson Un_iff eval.simps(1) imageI) done done next case (AllN amount φ) show ?case apply(cases amount) apply (simp_all add: AllN) unfolding steph[symmetric] apply(simp add: eval_list_disj) unfolding AllN[symmetric] unfolding eval_neg[symmetric, of "(QE_dnf' opt step φ)"] unfolding opt[symmetric, of "neg(QE_dnf' opt step φ)"] unfolding Set.bex_simps(8)[symmetric] unfolding HOL.imp_conv_disj unfolding HOL.de_Morgan_conj[symmetric] unfolding HOL.not_ex[symmetric] unfolding HOL.Not_eq_iff unfolding dnf_modified_eval[symmetric, of "(opt (neg(QE_dnf' opt step φ)))"] apply(rule ex_cong1) subgoal for nat xs apply(cases "length xs = Suc nat") apply simp_all apply(rule bex_cong) apply simp_all subgoal for f apply(cases f) apply simp apply(rule ex_cong1) unfolding eval_list_conj apply auto by (meson Un_iff eval.simps(1) imageI) done done qed auto theorem QE_dnf_eval: assumes steph : "⋀var amount new L F Γ. amount≤var+1 ⟹ (∃xs. (length xs = var+1 ∧ eval (list_conj (map fm.Atom L @ F)) (xs @ Γ))) = (∃xs. (length xs = var+1 ∧eval (step amount var L F) (xs @ Γ)))" assumes opt : "⋀xs F . eval (opt F) xs = eval F xs" shows "eval (QE_dnf opt step φ) xs = eval φ xs" proof(induction φ arbitrary:xs) case (Atom x) then show ?case by (simp add: simp_atom_eval) next case (And φ1 φ2) then show ?case by (simp add: eval_and) next case (Or φ1 φ2) then show ?case by (simp add: eval_or) next case (Neg φ) then show ?case by (metis eval.simps(6) eval_neg QE_dnf.simps(3)) next case (ExQ φ) have h : "(∃x. ∃(al, fl, n)∈set (dnf_modified (opt (QE_dnf opt step φ))). ∃L. length L = n ∧ (∀a∈set al. aEval a (L @ x # xs)) ∧ (∀f∈set fl. eval f (L @ x # xs))) = (∃(al, fl, n)∈set (dnf_modified (opt (QE_dnf opt step φ))). ∃x. ∃L. length L = n ∧ (∀a∈set al. aEval a (L @ x # xs)) ∧ (∀f∈set fl. eval f (L @ x # xs)))" apply safe by blast+ have lessThan : "⋀c. Suc 0 ≤ c + 1" by simp show ?case apply (simp add:eval_list_disj) unfolding ExQ[symmetric] unfolding opt[symmetric, of "(QE_dnf opt step φ)"] unfolding dnf_modified_eval[symmetric, of "opt(QE_dnf opt step φ)"] unfolding h apply(rule bex_cong) apply simp subgoal for f apply(cases f) apply simp subgoal for a b c using steph[of "Suc 0" c a b xs, symmetric, OF lessThan] apply (simp add:eval_list_conj) apply safe subgoal for xs' l' l'' apply(rule exI[where x="l'!c"]) apply(rule exI[where x="take c l'"]) apply auto apply (metis Un_iff append.assoc append_Cons append_Nil eval.simps(1) image_eqI lessI order_refl take_Suc_conv_app_nth take_all) by (metis Un_iff append.assoc append_Cons append_Nil lessI order_refl take_Suc_conv_app_nth take_all) subgoal for A B C D apply(rule exI[where x="D@[C]"]) by auto subgoal for A B apply(rule exI[where x="B@[A]"]) by auto done done done next case (AllQ φ) have h : "(∃x. ∃(al, fl, n)∈set (dnf_modified (opt (neg(QE_dnf opt step φ)))). ∃L. length L = n ∧ (∀a∈set al. aEval a (L @ x # xs)) ∧ (∀f∈set fl. eval f (L @ x # xs))) = (∃(al, fl, n)∈set (dnf_modified (opt (neg(QE_dnf opt step φ)))). ∃x. ∃L. length L = n ∧ (∀a∈set al. aEval a (L @ x # xs)) ∧ (∀f∈set fl. eval f (L @ x # xs)))" apply safe by blast+ have lessThan : "⋀c. Suc 0 ≤ c + 1" by simp show ?case apply (simp add:eval_list_disj) unfolding AllQ[symmetric] unfolding eval_neg[symmetric, of "(QE_dnf opt step φ)"] unfolding opt[symmetric, of "neg(QE_dnf opt step φ)"] unfolding HOL.Not_eq_iff[symmetric, of "(∀f∈set (dnf_modified (opt (neg (QE_dnf opt step φ)))). ¬ eval (case f of (al, fl, n) ⇒ ExN (Suc n) (step (Suc 0) n al fl)) xs)"] unfolding SMT.verit_connective_def(3)[symmetric] unfolding boundedFlipNegQuantifier unfolding dnf_modified_eval[symmetric, of "opt(neg(QE_dnf opt step φ))"] unfolding h apply(rule bex_cong) apply simp subgoal for f apply(cases f) apply simp subgoal for a b c using steph[of "Suc 0" c a b xs, symmetric,OF lessThan] apply (simp add:eval_list_conj) apply safe subgoal for xs' l' l'' apply(rule exI[where x="l'!c"]) apply(rule exI[where x="take c l'"]) apply auto apply (metis Un_iff append.assoc append_Cons append_Nil eval.simps(1) image_eqI lessI order_refl take_Suc_conv_app_nth take_all) by (metis Un_iff append.assoc append_Cons append_Nil lessI order_refl take_Suc_conv_app_nth take_all) subgoal for A B C D apply(rule exI[where x="D@[C]"]) by auto subgoal for A B apply(rule exI[where x="B@[A]"]) by auto done done done next case (ExN x1 φ) show ?case proof(cases x1) case 0 then show ?thesis using ExN by simp next case (Suc nat) have h : "(∃l. length l = Suc nat ∧ (∃(al, fl, n)∈set (dnf_modified (opt (QE_dnf opt step φ))). ∃L. length L = n ∧ (∀a∈set al. aEval a (L @ l @ xs)) ∧ (∀f∈set fl. eval f (L @ l @ xs)))) = (∃(al, fl, n)∈set (dnf_modified (opt (QE_dnf opt step φ))). (∃l. length l = Suc nat ∧ (∃L. length L = n ∧ (∀a∈set al. aEval a (L @ l @ xs)) ∧ (∀f∈set fl. eval f (L @ l @ xs)))))" apply safe by blast+ have lessThan : "⋀c. Suc nat ≤ c + nat + 1" by simp show ?thesis apply (simp add:eval_list_disj Suc) unfolding ExN[symmetric] unfolding opt[symmetric, of "(QE_dnf opt step φ)"] unfolding dnf_modified_eval[symmetric, of "(opt (QE_dnf opt step φ))"] unfolding h apply(rule bex_cong) apply simp subgoal for f apply(cases f) subgoal for a b c apply simp using steph[of "Suc nat" "c+nat",symmetric, OF lessThan] apply (auto simp add:eval_list_conj) subgoal for L apply(rule exI[where x="drop c L"]) apply auto apply(rule exI[where x="take c L"]) apply auto apply (metis Un_iff append.assoc append_take_drop_id eval.simps(1) image_eqI) by (metis Un_iff append.assoc append_take_drop_id) subgoal for L l apply(rule exI[where x="l@L"]) by auto done done done qed next case (AllN x1 φ) then show ?case proof(cases x1) case 0 then show ?thesis using AllN by simp next case (Suc nat) have h : "(∃l. length l = Suc nat ∧ (∃(al, fl, n)∈set (dnf_modified (opt (neg(QE_dnf opt step φ)))). ∃L. length L = n ∧ (∀a∈set al. aEval a (L @ l @ xs)) ∧ (∀f∈set fl. eval f (L @ l @ xs)))) = (∃(al, fl, n)∈set (dnf_modified (opt (neg(QE_dnf opt step φ)))). (∃l. length l = Suc nat ∧ (∃L. length L = n ∧ (∀a∈set al. aEval a (L @ l @ xs)) ∧ (∀f∈set fl. eval f (L @ l @ xs)))))" apply safe by blast+ have lessThan : "⋀c. Suc nat ≤ c + nat + 1" by simp show ?thesis apply (simp add:eval_list_disj Suc) unfolding AllN[symmetric] unfolding eval_neg[symmetric, of "QE_dnf opt step φ"] unfolding HOL.imp_conv_disj unfolding HOL.de_Morgan_conj[symmetric] unfolding opt[symmetric, of "neg(QE_dnf opt step φ)"] unfolding dnf_modified_eval[symmetric, of "(opt (neg(QE_dnf opt step φ)))"] unfolding HOL.Not_eq_iff[symmetric, of "(∀f∈set (dnf_modified (opt (neg (QE_dnf opt step φ)))). ¬ eval (case f of (al, fl, n) ⇒ ExN (Suc (n + nat)) (step (Suc nat) (n + nat) al fl)) xs)"] unfolding SMT.verit_connective_def(3)[symmetric] unfolding boundedFlipNegQuantifier unfolding h apply(rule bex_cong) apply simp subgoal for f apply(cases f) subgoal for a b c apply simp using steph[of "Suc nat" "c+nat",symmetric, OF lessThan] apply (auto simp add:eval_list_conj) subgoal for L apply(rule exI[where x="drop c L"]) apply auto apply(rule exI[where x="take c L"]) apply auto apply (metis Un_iff append.assoc append_take_drop_id eval.simps(1) image_eqI) by (metis Un_iff append.assoc append_take_drop_id) subgoal for L l apply(rule exI[where x="l@L"]) by auto done done done qed qed auto lemma opt: "eval ((push_forall ∘ nnf ∘ unpower 0 o groupQuantifiers o clearQuantifiers) F) L= eval F L" using push_forall_eval eval_nnf unpower_eval groupQuantifiers_eval clearQuantifiers_eval by auto lemma opt': "eval ((push_forall ( nnf ( unpower 0 ( groupQuantifiers (clearQuantifiers F)))))) L= eval F L" using push_forall_eval eval_nnf unpower_eval groupQuantifiers_eval clearQuantifiers_eval by auto lemma opt_no_group: "eval ((push_forall ∘ nnf ∘ unpower 0 o clearQuantifiers) F) L= eval F L" using push_forall_eval eval_nnf unpower_eval clearQuantifiers_eval by auto lemma repeatAmountOfQuantifiers_helper_eval : assumes "⋀xs F. eval F xs = eval (step F) xs" shows "eval F xs = eval (repeatAmountOfQuantifiers_helper step n F) xs" apply(induction n arbitrary : F) apply simp_all subgoal for n F using assms[of F xs] by auto done lemma repeatAmountOfQuantifiers_eval : assumes "⋀xs F. eval F xs = eval (step F) xs" shows "eval F xs = eval (repeatAmountOfQuantifiers step F) xs" proof- define F' where "F' = step F" have h: "eval F xs = eval F' xs" using assms unfolding F'_def by auto show ?thesis apply (simp add: F'_def[symmetric] h) using repeatAmountOfQuantifiers_helper_eval[OF assms] by auto qed end
subsection "Heuristic Proofs" theory HeuristicProofs imports VSQuad Heuristic OptimizationProofs begin lemma the_real_step_augment: assumes steph : "⋀xs var L F Γ. length xs = var ⟹ (∃x. eval (list_conj (map fm.Atom L @ F)) (xs @ x # Γ)) = (∃x. eval (step var L F) (xs @ x # Γ))" shows "(∃xs. (length xs = amount ∧ eval (list_disj (map(λ(L,F,n). ExN n (list_conj (map fm.Atom L @ F))) F)) (xs @ Γ))) = (eval (the_real_step_augment step amount F) Γ)" proof(induction amount arbitrary: F Γ) case 0 then show ?case by auto next case (Suc amount) have h1 : "⋀F. (∃x xs. length xs = amount ∧ F (xs @ x # Γ)) = (∃xs. length xs = Suc amount ∧ F (xs @ Γ))" by (smt (z3) Suc_inject append.assoc append_Cons append_Nil2 append_eq_conv_conj length_append_singleton lessI self_append_conv2 take_hd_drop) have h2: "⋀X x Γ. (∃f∈set (dnf_modified X). eval (case f of (L, F, n) ⇒ ExN n (list_conj (map fm.Atom L @ F))) (x @ Γ)) = (∃(al, fl, n)∈set (dnf_modified X). ∃L. length L = n ∧ (∀a∈set al. aEval a (L @ (x @ Γ))) ∧ (∀f∈set fl. eval f (L @ (x @ Γ))))" subgoal for X x Γ apply(rule bex_cong) apply simp_all subgoal for f apply(cases f) apply(auto simp add:eval_list_conj) by (metis Un_iff eval.simps(1) imageI) done done have h3 : "⋀G. (∃x. ∃f∈set F. G x f) = (∃f∈set F. ∃x. G x f)" by blast show ?case apply simp unfolding Suc[symmetric] unfolding eval_list_disj apply simp unfolding h1[symmetric, of "λx. (∃f∈set F. eval (case f of (L, F, n) ⇒ ExN n (list_conj (map fm.Atom L @ F))) x)"] unfolding HOL.ex_comm[of "λx xs. length xs = amount ∧ (∃f∈set F. eval (case f of (L, F, n) ⇒ ExN n (list_conj (map fm.Atom L @ F))) (xs @ x # Γ))"] unfolding HOL.ex_comm[of "λx xs. length xs = amount ∧ (∃f∈set (dnf_modified (push_forall (nnf (unpower 0 (groupQuantifiers (clearQuantifiers(list_disj (map (λ(L, F, n). ExN n (step (n + amount) L F)) F)))))))). eval (case f of (L, F, n) ⇒ ExN n (list_conj (map fm.Atom L @ F))) (xs @ x # Γ))"] apply(rule ex_cong1) apply simp subgoal for xs unfolding h2 unfolding dnf_modified_eval unfolding opt' unfolding eval_list_disj unfolding List.set_map Set.bex_simps(7) unfolding h3 apply(cases "length xs = amount") apply (simp_all add:opt) apply(rule bex_cong) apply simp_all subgoal for f apply(cases f) apply simp subgoal for a b c unfolding HOL.ex_comm[of "λx l. length l = c ∧ eval (list_conj (map fm.Atom a @ b)) (l @ xs @ x # Γ)"] unfolding HOL.ex_comm[of "λx l. length l = c ∧ eval (step (c + amount) a b) (l @ xs @ x # Γ)"] apply(rule ex_cong1) apply simp subgoal for l apply(cases "length l = c") apply simp_all using steph[of "l @ xs" "c + amount" a b Γ] by simp done done done done qed lemma step_converter : assumes steph : "⋀xs var L F Γ. length xs = var ⟹ (∃x. eval (list_conj (map fm.Atom L @ F)) (xs @ x # Γ)) = (∃x. eval (step var L F) (xs @ x # Γ))" shows "⋀var L F Γ. (∃xs. length xs = var + 1 ∧ eval (list_conj (map fm.Atom L @ F)) (xs @ Γ)) = (∃xs. (length xs = (var + 1)) ∧ eval (step var L F) (xs @ Γ))" proof safe fix var L F Γ xs assume h : "length xs = var + 1" "eval (list_conj (map fm.Atom L @ F)) (xs @ Γ)" have h1 : "length (take var xs) = var" using h by auto have h2 : "(∃x. eval (step var L F) (take var xs @ x # Γ))" using h steph[OF h1] by (metis Cons_nth_drop_Suc One_nat_def add.right_neutral add_Suc_right append.assoc append_Cons append_Nil append_take_drop_id drop_all lessI order_refl) then obtain x where h3: "eval (step var L F) (take var xs @ x # Γ)" by auto show "∃xs. length xs = var + 1 ∧ eval (step var L F) (xs @ Γ)" apply(rule exI[where x="take var xs @[x]"]) apply (auto) using h(1) apply simp using h3 by simp next fix var L F Γ xs assume h: "length xs = var + 1" "eval (step var L F) (xs @ Γ)" have h1 : "length (take var xs) = var" using h by auto have h2 : "(∃x. eval (list_conj (map fm.Atom L @ F)) (take var xs @ x # Γ))" using h steph[OF h1] by (metis Cons_nth_drop_Suc One_nat_def add.right_neutral add_Suc_right append.assoc append_Cons append_Nil append_take_drop_id drop_all lessI order_refl) then obtain x where h3: "eval (list_conj (map fm.Atom L @ F)) (take var xs @ x # Γ)" by auto show "∃xs. length xs = var + 1 ∧ eval (list_conj (map fm.Atom L @ F)) (xs @ Γ)" apply(rule exI[where x="take var xs @[x]"]) apply (auto) using h(1) apply simp using h3 by simp qed lemma step_augmenter_eval : assumes steph : "⋀xs var L F Γ. length xs = var ⟹ (∃x. eval (list_conj (map fm.Atom L @ F)) (xs @ x # Γ)) = (∃x. eval (step var L F) (xs @ x # Γ))" assumes heuristic: "⋀n var L F. heuristic n L F = var ⟹ var ≤ n" shows "⋀var amount L F Γ. amount ≤ var + 1 ⟹ (∃xs. length xs = var + 1 ∧ eval (list_conj (map fm.Atom L @ F)) (xs @ Γ)) = (∃xs. (length xs = (var + 1)) ∧ eval (step_augment step heuristic amount var L F) (xs @ Γ))" subgoal for var amount L F Γ proof(induction var arbitrary: L F Γ amount) case 0 then have "amount = 0 ∨ amount = Suc 0" by auto then show ?case apply simp using steph[of "[]" 0 L F Γ] apply auto apply (metis append_Cons length_Cons list.size(3) self_append_conv2) apply (metis append_Cons length_Cons list.size(3) self_append_conv2) apply (metis Suc_length_conv append_Cons length_0_conv self_append_conv2) by (metis Suc_length_conv append_Cons append_self_conv2 length_0_conv) next case (Suc var) define heu where "heu = heuristic (Suc var) L F" have heurange : "heu ≤ Suc var" unfolding heu_def by (simp add: heuristic) have lessThan1 : "1 ≤ var + 1" by auto { fix amount assume amountLessThan: "amount ≤ var + 1" have "(∃xs. length xs = Suc (Suc var) ∧ eval (list_conj (map fm.Atom L @ F)) (xs @ Γ)) = (∃xs. length xs = Suc (Suc var) ∧ eval (step (Suc var) (map (swap_atom (Suc var) heu) L) (map (swap_fm (Suc var) heu) F)) (xs @ Γ))" proof(safe) fix xs assume h: "length (xs::real list) = Suc (Suc var)" "eval (list_conj (map fm.Atom L @ F)) (xs @ Γ)" then have length : "length (take (Suc var) (swap_list (Suc var) heu xs)) = Suc var" by auto have take: "(take (Suc var) (swap_list (Suc var) heu xs) @ xs ! heu # Γ) = (swap_list (Suc var) heu (xs @ Γ)) " using h(1) unfolding swap_list.simps by (smt (verit, ccfv_threshold) Cons_nth_drop_Suc append.right_neutral append_Nil2 append_assoc append_eq_conv_conj append_self_conv2 append_take_drop_id drop0 heu_def heurange le_imp_less_Suc length_greater_0_conv length_list_update lessI list.sel(1) list.sel(3) list.simps(3) list.size(3) list_update_append nth_Cons_0 nth_append nth_append_length nth_list_update_eq take0 take_hd_drop) have length1 : "Suc var < length (xs @ Γ)" using h by auto have length2 : "heu < length (xs @ Γ)" using h heurange by auto have h1: "(∃x. eval (step (Suc var) (map (swap_atom (Suc var) heu) L) (map (swap_fm (Suc var) heu) F)) (take (Suc var) (swap_list (Suc var) heu xs) @ x # Γ))" unfolding steph[OF length, symmetric] apply(rule exI[where x="nth xs heu"]) using h unfolding eval_list_conj take apply (auto simp del:swap_list.simps) unfolding swap_fm[OF length1 length2,symmetric] swap_atom[OF length1 length2,symmetric] by (meson UnCI eval.simps(1) imageI)+ then obtain x where heval: "eval (step (Suc var) (map (swap_atom (Suc var) heu) L) (map (swap_fm (Suc var) heu) F)) (take (Suc var) (swap_list (Suc var) heu xs) @ x # Γ)" by auto show "∃xs. length xs = Suc (Suc var) ∧ eval (step (Suc var) (map (swap_atom (Suc var) heu) L) (map (swap_fm (Suc var) heu) F)) (xs @ Γ)" apply(rule exI[where x="take (Suc var) (swap_list (Suc var) heu xs) @ [x]"]) apply auto using h apply simp using heval by auto next fix xs assume h : "length xs = Suc (Suc var)"" eval (step (Suc var) (map (swap_atom (Suc var) heu) L) (map (swap_fm (Suc var) heu) F)) (xs @ Γ)" define choppedXS where "choppedXS = take (Suc var) xs" then have length : "length choppedXS = Suc var" using h(1) by force have "(∃x. eval (step (Suc var) (map (swap_atom (Suc var) heu) L) (map (swap_fm (Suc var) heu) F)) (choppedXS @ x # Γ))" using h(2) choppedXS_def by (metis append.assoc append_Cons append_Nil2 append_eq_conv_conj h(1) lessI take_hd_drop) then have "∃x. (∀l∈ set L. aEval (swap_atom (Suc var) heu l) (choppedXS@x#Γ)) ∧ (∀f∈ set F. eval (swap_fm (Suc var) heu f) (choppedXS@x#Γ))" unfolding steph[symmetric, OF length, of "(map (swap_atom (Suc var) heu) L)" "(map (swap_fm (Suc var) heu) F)" Γ] eval_list_conj apply auto by (metis Un_iff eval.simps(1) imageI) then obtain x where x : "(∀l∈set L. aEval (swap_atom (Suc var) heu l) (choppedXS @ x # Γ)) ∧ (∀f∈set F. eval (swap_fm (Suc var) heu f) (choppedXS @ x # Γ))" by auto have length1 : "Suc var < length (swap_list (Suc var) heu (choppedXS @ [x]) @ Γ)" by (simp add: length) have length2 : "heu < length (swap_list (Suc var) heu (choppedXS @ [x]) @ Γ)" using ‹Suc var < length (swap_list (Suc var) heu (choppedXS @ [x]) @ Γ)› heurange by linarith have swapswap : "(swap_list (Suc var) heu (swap_list (Suc var) heu (choppedXS @ [x]) @ Γ)) = (choppedXS @ [x]) @ Γ" apply auto by (smt (z3) Cons_nth_drop_Suc append_eq_conv_conj append_same_eq heurange id_take_nth_drop le_neq_implies_less length length1 length_append_singleton lessI list.sel(1) list_update_append1 list_update_length list_update_swap nth_append nth_append_length nth_list_update_neq swap_list.simps take_hd_drop take_update_swap upd_conv_take_nth_drop) show "∃xs. length xs = Suc (Suc var) ∧ eval (list_conj (map fm.Atom L @ F)) (xs @ Γ)" apply(rule exI[where x="swap_list (Suc var) heu (choppedXS @ [x])"]) apply(auto simp add: eval_list_conj simp del: swap_list.simps) apply(simp add :length) unfolding swap_atom[OF length1 length2] swap_fm[OF length1 length2] swapswap using x by auto qed also have "... = (∃xs. length xs = Suc (Suc var) ∧ (∃f∈set (dnf ((push_forall ∘ nnf ∘ unpower 0 o groupQuantifiers o clearQuantifiers)(step (Suc var) (map (swap_atom (Suc var) heu) L) (map (swap_fm (Suc var) heu) F)))). eval (case f of (x, xa) ⇒ step_augment step heuristic amount var x xa) (xs @ Γ)))" unfolding opt[of "(step (Suc var) (map (swap_atom (Suc var) heu) L) (map (swap_fm (Suc var) heu) F))", symmetric] unfolding dnf_eval[of "(push_forall ∘ nnf ∘ unpower 0 o groupQuantifiers o clearQuantifiers)(step (Suc var) (map (swap_atom (Suc var) heu) L) (map (swap_fm (Suc var) heu) F))", symmetric] proof(safe) fix xs a b assume h: "length xs = Suc (Suc var)"" (a, b) ∈ set (dnf ((push_forall ∘ nnf ∘ unpower 0 o groupQuantifiers o clearQuantifiers)(step (Suc var) (map (swap_atom (Suc var) heu) L) (map (swap_fm (Suc var) heu) F)))) "" ∀a∈set a. aEval a (xs @ Γ) "" ∀f∈set b. eval f (xs @ Γ)" have "(∃xs'. length xs' = var + 1 ∧ eval (step_augment step heuristic amount var a b) (xs' @ xs ! Suc var # Γ))" unfolding Suc(1)[of amount a b "nth xs (Suc var)#Γ", OF amountLessThan, symmetric] apply(rule exI[where x="take (Suc var) xs"]) using h(1) h(3-4) apply(auto simp add: eval_list_conj) apply (metis Cons_nth_drop_Suc append_Cons append_eq_append_conv2 append_eq_conv_conj append_take_drop_id lessI) by (metis Cons_nth_drop_Suc append_Cons append_eq_append_conv2 append_eq_conv_conj append_take_drop_id lessI) then obtain xs' where xs': "length xs' = var + 1" "eval (step_augment step heuristic amount var a b) (xs' @ xs ! Suc var # Γ)" by auto show "∃xs. length xs = Suc (Suc var) ∧ (∃f∈set (dnf ((push_forall ∘ nnf ∘ unpower 0 o groupQuantifiers o clearQuantifiers)(step (Suc var) (map (swap_atom (Suc var) heu) L) (map (swap_fm (Suc var) heu) F)))). eval (case f of (x, xa) ⇒ step_augment step heuristic amount var x xa) (xs @ Γ))" apply(rule exI[where x="xs' @[ xs ! Suc var]"]) apply auto using xs' apply simp apply(rule bexI[where x="(a,b)"]) using xs' h apply(cases amount) apply (simp_all add:eval_list_conj) using h(2) by auto next fix xs a b assume h: "length xs = Suc (Suc var) "" (a, b) ∈ set (dnf ((push_forall ∘ nnf ∘ unpower 0 o groupQuantifiers o clearQuantifiers)(step (Suc var) (map (swap_atom (Suc var) heu) L) (map (swap_fm (Suc var) heu) F)))) "" eval (step_augment step heuristic amount var a b) (xs @ Γ)" have "(∃xs'. length xs' = var + 1 ∧ eval (list_conj (map fm.Atom a @ b)) (xs' @ xs ! Suc var # Γ))" unfolding Suc(1)[of amount a b "nth xs (Suc var)#Γ", OF amountLessThan] apply(rule exI[where x="take (Suc var) xs"]) using h(1) h(3) apply auto by (metis Cons_nth_drop_Suc append.right_neutral append_Cons append_assoc append_eq_conv_conj append_self_conv2 append_take_drop_id lessI) then obtain xs' where xs': "length xs' = var + 1" " eval (list_conj (map fm.Atom a @ b)) (xs' @ xs ! Suc var # Γ)" by auto show "∃xs. length xs = Suc (Suc var) ∧ (∃(al, fl) ∈set (dnf ((push_forall ∘ nnf ∘ unpower 0 o groupQuantifiers o clearQuantifiers)(step (Suc var) (map (swap_atom (Suc var) heu) L) (map (swap_fm (Suc var) heu) F)))). (∀a∈set al. aEval a (xs @ Γ)) ∧ (∀f∈set fl. eval f (xs @ Γ)))" apply(rule exI[where x="xs' @[ xs ! Suc var]"]) apply auto using xs' apply simp apply(rule bexI[where x="(a,b)"]) using xs' h apply (simp_all add: eval_list_conj) proof - assume "∀f∈fm.Atom ` set a ∪ set b. eval f (xs' @ xs ! Suc var # Γ)" then have "∀f. f ∈ fm.Atom ` set a ∪ set b ⟶ eval f (xs' @ xs ! Suc var # Γ)" by meson then have f1: "v ∉ set a ∨ eval (fm.Atom v) (xs' @ xs ! Suc var # Γ)" for v by blast obtain aa :: atom where "(∃v0. v0 ∈ set a ∧ ¬ eval (fm.Atom v0) (xs' @ xs ! Suc var # Γ)) = (aa ∈ set a ∧ ¬ eval (fm.Atom aa) (xs' @ xs ! Suc var # Γ))" by blast then show "∀a∈set a. aEval a (xs' @ xs ! Suc var # Γ)" using f1 eval.simps(1) by auto qed qed finally have "(∃xs. length xs = Suc (Suc var) ∧ eval (list_conj (map fm.Atom L @ F)) (xs @ Γ)) = (∃xs. length xs = Suc (Suc var) ∧ (∃f∈set (dnf ((push_forall ∘ nnf ∘ unpower 0 o groupQuantifiers o clearQuantifiers) (step (Suc var) (map (swap_atom (Suc var) heu) L) (map (swap_fm (Suc var) heu) F)))). eval (case f of (x, xa) ⇒ step_augment step heuristic amount var x xa) (xs @ Γ)))" by auto }then show ?case apply(cases amount) using Suc(2) by (simp_all add:eval_list_disj heu_def[symmetric]) qed done lemma qe_eq_repeat_eval_augment : "amount ≤ var+1 ⟹ (∃xs. (length xs = var + 1) ∧ eval (list_conj (map fm.Atom L @ F)) (xs @ Γ)) = (∃xs. (length xs = var + 1) ∧ eval (step_augment qe_eq_repeat IdentityHeuristic amount var L F) (xs @ Γ))" apply(rule step_augmenter_eval[of qe_eq_repeat IdentityHeuristic amount var L F Γ]) using qe_eq_repeat_eval apply blast by auto lemma qe_eq_repeat_eval' : " (∃xs. (length xs = var + 1) ∧ eval (list_conj (map fm.Atom L @ F)) (xs @ Γ)) = (∃xs. (length xs = var + 1) ∧ eval (qe_eq_repeat var L F) (xs @ Γ))" apply(rule step_converter[of qe_eq_repeat var L F Γ]) using qe_eq_repeat_eval by blast lemma gen_qe_eval_augment : "amount ≤ var+1 ⟹ (∃xs. (length xs = var + 1) ∧ eval (list_conj (map fm.Atom L @ F)) (xs @ Γ)) = (∃xs. (length xs = var + 1) ∧ eval (step_augment gen_qe IdentityHeuristic amount var L F) (xs @ Γ))" apply(rule step_augmenter_eval[of gen_qe IdentityHeuristic amount var L F Γ]) using gen_qe_eval apply blast by auto lemma gen_qe_eval' : " (∃xs. (length xs = var + 1) ∧ eval (list_conj (map fm.Atom L @ F)) (xs @ Γ)) = (∃xs. (length xs = var + 1) ∧ eval (gen_qe var L F) (xs @ Γ))" apply(rule step_converter[of gen_qe var L F Γ]) using gen_qe_eval by blast lemma luckyFind_eval_augment : "amount ≤ var+1 ⟹ (∃xs. (length xs = var + 1) ∧ eval (list_conj (map fm.Atom L @ F)) (xs @ Γ)) = (∃xs. (length xs = var + 1) ∧ eval (step_augment luckyFind' IdentityHeuristic amount var L F) (xs @ Γ))" apply(rule step_augmenter_eval[of luckyFind' IdentityHeuristic amount var L F Γ]) using luckyFind'_eval apply blast by auto lemma luckyFind_eval' : " (∃xs. (length xs = var + 1) ∧ eval (list_conj (map fm.Atom L @ F)) (xs @ Γ)) = (∃xs. (length xs = var + 1) ∧ eval (luckyFind' var L F) (xs @ Γ))" apply(rule step_converter[of luckyFind' var L F Γ]) using luckyFind'_eval by blast lemma luckiestFind_eval' : " (∃xs. (length xs = var + 1) ∧ eval (list_conj (map fm.Atom L @ F)) (xs @ Γ)) = (∃xs. (length xs = var + 1) ∧ eval (luckiestFind var L F) (xs @ Γ))" apply(rule step_converter[of luckiestFind var L F Γ]) using luckiestFind_eval by blast lemma sortedListMember : "sorted_list_of_fset b = var # list ⟹ fmember var b " by (metis fset_of_list_elem list.set_intros(1) sorted_list_of_fset_simps(2)) lemma rangeHeuristic : assumes "heuristicPicker n L F = Some (var, step)" shows "var≤n" proof(cases "aquireData n L") case (fields a b c) then show ?thesis using assms apply(simp_all del: aquireData.simps getBest.simps) apply(cases "getBest a L") apply(simp_all del: aquireData.simps getBest.simps) apply(cases F) apply(simp_all del: aquireData.simps getBest.simps) apply(cases "getBest c L") apply(simp_all del: aquireData.simps getBest.simps) apply(cases "getBest b L")apply(simp_all del: aquireData.simps getBest.simps) apply (metis not_le_imp_less option.distinct(1) option.inject prod.inject) apply (metis not_le_imp_less option.distinct(1) option.inject prod.inject) apply(cases "getBest b L")apply(simp_all del: aquireData.simps getBest.simps) by (metis not_le_imp_less option.distinct(1) option.inject prod.inject)+ qed lemma pickedOneOfThem : assumes "heuristicPicker n L F = Some (var, step)" shows "step = qe_eq_repeat ∨ step = gen_qe ∨ step = luckyFind'" using assms apply(cases "aquireData n L") subgoal for l e g using assms apply(simp_all del: aquireData.simps getBest.simps) apply(cases "getBest l L") apply(simp_all del: aquireData.simps getBest.simps) apply(cases F) apply(simp_all del: aquireData.simps getBest.simps) apply(cases "getBest g L") apply(simp_all del: aquireData.simps getBest.simps) apply(cases "getBest e L")apply(simp_all del: aquireData.simps getBest.simps) apply (metis option.distinct(1) option.inject prod.inject) apply (metis option.distinct(1) option.inject prod.inject) apply(cases "getBest e L")apply(simp_all del: aquireData.simps getBest.simps) by (metis option.distinct(1) option.inject prod.inject)+ done lemma superPicker_eval : "amount≤ var+1 ⟹ (∃xs. length xs = var + 1 ∧ eval (list_conj (map fm.Atom L @ F)) (xs @ Γ)) = (∃xs. (length xs = (var + 1)) ∧ eval (superPicker amount var L F) (xs @ Γ))" proof(induction var arbitrary : L F Γ amount) case 0 then show ?case apply(simp del:heuristicPicker.simps) apply(cases "heuristicPicker 0 L F") apply(cases amount) apply (simp_all del:heuristicPicker.simps) subgoal for a apply(cases a) apply (simp_all del:heuristicPicker.simps) subgoal for var step apply(cases var) apply(cases amount) apply(simp_all del:heuristicPicker.simps) proof- assume h: "heuristicPicker 0 L F = Some (0, step)" show "(∃xs. length xs = Suc 0 ∧ eval (list_conj (map fm.Atom L @ F)) (xs @ Γ)) = (∃xs. length xs = Suc 0 ∧ eval (step 0 L F) (xs @ Γ)) " using pickedOneOfThem[OF h] using qe_eq_repeat_eval'[of 0 L F Γ] gen_qe_eval'[of 0 L F Γ] luckyFind_eval'[of 0 L F Γ] by auto next show "⋀nat. amount ≤ Suc 0 ⟹ heuristicPicker 0 L F = Some (Suc nat, step) ⟹ a = (Suc nat, step) ⟹ var = Suc nat ⟹ (∃xs. length xs = Suc 0 ∧ eval (list_conj (map fm.Atom L @ F)) (xs @ Γ)) = (∃xs. length xs = Suc 0 ∧ eval (superPicker amount 0 L F) (xs @ Γ)) " apply(cases amount) by(simp_all del:heuristicPicker.simps) qed done done next case (Suc i) then show ?case apply(cases "heuristicPicker (Suc i) L F") apply(cases amount) apply(simp_all del:heuristicPicker.simps) subgoal for a apply(cases a) apply(simp_all del:heuristicPicker.simps) apply(cases amount) apply simp apply(cases amount) apply(simp_all del:heuristicPicker.simps) subgoal for var step amountPred amountPred' proof- assume amountPred : "amountPred ≤ Suc i" assume ih: "(⋀amount L F Γ. amount ≤ Suc i ⟹ (∃xs. length xs = Suc i ∧ eval (list_conj (map fm.Atom L @ F)) (xs @ Γ)) = (∃xs. length xs = Suc i ∧ eval (superPicker amount i L F) (xs @ Γ)))" assume h0 : "heuristicPicker (Suc i) L F = Some (var, step)" have h1: "⋀xs X F. (∃f∈set (map (λ(x, y). F x y) (dnf X)). eval f (xs)) = (∃(al,fl)∈set(dnf X). eval (F al fl) (xs))" subgoal for xs X F apply auto subgoal for a b apply(rule bexI[where x="(a,b)"]) apply simp_all done done done have eval_map : "⋀al fl xs Γ.(∀f∈set (map fm.Atom al @ fl). eval f (xs @ Γ)) = ((∀a∈set al. aEval a (xs @ Γ)) ∧ (∀f∈set fl. eval f (xs @ Γ)))" apply auto by (meson Un_iff eval.simps(1) imageI) have rearangeExists : "⋀ X F.((∃xs. length xs = Suc (Suc i) ∧ (∃(al, fl)∈set (dnf X). F al fl xs)) = (∃(al,fl)∈set (dnf X).(∃xs. length xs = Suc (Suc i) ∧ F al fl xs)))" by blast have dropTheEnd : "⋀F Γ.(∃xs. length xs = Suc (Suc i) ∧ F (xs @ Γ)) = (∃x. (∃xs. length xs = i+1 ∧ F (xs @ x#Γ)))" apply(safe) subgoal for F Γ xs apply(rule exI[where x="nth xs (i+1)"]) apply(rule exI[where x="take (i+1) xs"]) apply auto by (metis Cons_nth_drop_Suc append.right_neutral append_Cons append_assoc append_eq_conv_conj append_self_conv2 append_take_drop_id lessI) subgoal for F Γ x xs apply(rule exI[where x="xs@[x]"]) by auto done have h2 : "⋀X Γ amount. amount≤ Suc i ⟹((∃xs. length xs = Suc (Suc i) ∧ (∃(al, fl)∈set (dnf X). eval (superPicker amount i al fl) (xs @ Γ))) = (∃xs. length xs = Suc (Suc i) ∧ (∃(al, fl)∈set (dnf X). (∀a∈set al. aEval a (xs@Γ))∧(∀f∈set fl. eval f (xs@Γ)))))" subgoal for X Γ amount unfolding rearangeExists apply(rule bex_cong) apply simp subgoal for x apply (cases x) apply simp subgoal for al fl unfolding dropTheEnd unfolding dropTheEnd[of"λxs. (∀a∈set al. aEval a xs) ∧ (∀f∈set fl. eval f xs)"] apply simp unfolding ih[of amount al fl "_#Γ",symmetric] unfolding eval_list_conj apply(rule ex_cong1) subgoal for xa apply(rule ex_cong1) subgoal for xab apply auto by (meson Un_iff eval.simps(1) image_eqI) done done done done done have h3 : "⋀L F. (∃xs. length xs = Suc (Suc i) ∧ eval (step (Suc i) L F) (xs@Γ)) = (∃xs. length xs = Suc (Suc i) ∧ eval (list_conj (map fm.Atom L @ F)) (xs @ Γ))" subgoal for L F using pickedOneOfThem[OF h0] using qe_eq_repeat_eval'[of "Suc i" L F Γ] gen_qe_eval'[of "Suc i" L F Γ] luckyFind_eval'[of "Suc i" L F Γ] by auto done have heurange : "var≤ Suc i" using rangeHeuristic[OF h0] by auto show ?thesis unfolding eval_list_disj unfolding h1 unfolding h2[OF amountPred] unfolding dnf_eval unfolding opt' unfolding h3 proof(safe) fix xs assume h : "length xs = Suc (Suc i)" "eval (list_conj (map fm.Atom L @ F)) (xs @ Γ)" have h3 : "var < length (xs @ Γ)" using h heurange by auto have h1: "(swap_list (Suc i) var (xs @ Γ)) = (swap_list (Suc i) var xs @ Γ)" using h(1) heurange apply simp by (simp add: list_update_append nth_append) have h2 : "Suc i < length (xs @ Γ)" using h by auto show "∃xs. length xs = Suc (Suc i) ∧ eval (list_conj (map fm.Atom (map (swap_atom (Suc i) var) L) @ map (swap_fm (Suc i) var) F)) (xs @ Γ)" apply(rule exI[where x="swap_list (Suc i) var xs"]) apply(auto simp add:h eval_list_conj simp del:swap_list.simps) apply(simp add: h) using swap_fm[OF h2 h3] swap_atom[OF h2 h3] unfolding h1 using h(2) unfolding eval_list_conj apply auto by (meson Un_iff eval.simps(1) imageI) next fix xs assume h : "length xs = Suc (Suc i)""eval (list_conj (map fm.Atom (map (swap_atom (Suc i) var) L) @ map (swap_fm (Suc i) var) F)) (xs @ Γ)" have h3 : "var < length (swap_list (Suc i) var xs @ Γ)" using h heurange by auto have h1: "swap_list (Suc i) var (swap_list (Suc i) var xs @ Γ) = xs @ Γ" apply auto using h(1) heurange by (smt (z3) le_imp_less_Suc length_list_update lessI list_update_append list_update_id list_update_overwrite list_update_swap nth_append nth_list_update_eq) have h2 : "Suc i < length (swap_list (Suc i) var xs @ Γ)" using h by auto show "∃xs. length xs = Suc (Suc i) ∧ eval (list_conj (map fm.Atom L @ F)) (xs @ Γ)" apply(rule exI[where x="swap_list (Suc i) var xs"]) apply(auto simp add:eval_list_conj simp del:swap_list.simps) apply(simp add: h) unfolding swap_fm[OF h2 h3] swap_atom[OF h2 h3] unfolding h1 using h(2) unfolding eval_list_conj apply auto apply (meson Un_iff eval.simps(1) imageI) done qed qed done done qed lemma brownHueristic_less_than: "brownsHeuristic n L F = var ⟹ var≤ n" apply simp apply(cases "sorted_list_of_fset ((λx. case foldl (λ(maxdeg, totaldeg, appearancecount) l. let deg = MPoly_Type.degree (case l of Less p ⇒ p | Eq p ⇒ p | Leq p ⇒ p | Neq p ⇒ p) x in (max maxdeg deg, totaldeg + deg, appearancecount + (if 0 < deg then 1 else 0))) (0, 0, 0) L of (a, b, c) ⇒ Quad (a, b, c, x)) |`| fset_of_list [0..<n])") apply auto subgoal for a apply(cases a) by auto done end
subsection "Top-Level Algorithm Proofs" theory ExportProofs imports HeuristicProofs Exports (*"HOL-Library.Code_Real_Approx_By_Float"*) HOL.String "HOL-Library.Code_Target_Int" "HOL-Library.Code_Target_Nat" PrettyPrinting Show.Show_Real begin theorem "eval (Unpower f) L = eval f L" unfolding unpower_eval Unpower_def by auto theorem VSLuckiest: "∀xs. eval (VSLuckiest φ) xs = eval φ xs" unfolding VSLuckiest_def Unpower_def opt_def using QE_dnf_eval[OF luckiestFind_eval' opt_no_group] opt_no_group by fastforce theorem VSLuckiestBlocks : "∀xs. eval (VSLuckiestBlocks φ) xs = eval φ xs" unfolding VSLuckiestBlocks_def Unpower_def opt_group_def using QE_dnf'_eval[OF the_real_step_augment[OF luckiestFind_eval, of "λx _ _. x"] opt] using opt by fastforce theorem VSEquality : "∀xs. eval (VSEquality φ) xs = eval φ xs" unfolding VSEquality_def Unpower_def opt_def using QE_dnf_eval[OF qe_eq_repeat_eval' opt_no_group] using opt_no_group VSLuckiest by fastforce theorem VSEqualityBlocks : "∀xs. eval (VSEqualityBlocks φ) xs = eval φ xs" unfolding VSEqualityBlocks_def Unpower_def opt_group_def using QE_dnf'_eval[OF the_real_step_augment[OF qe_eq_repeat_eval, of "λx _ _. x"] opt] using opt VSLuckiestBlocks by fastforce theorem VSGeneralBlocks : "∀xs. eval (VSGeneralBlocks φ) xs = eval φ xs" unfolding VSGeneralBlocks_def Unpower_def opt_group_def using QE_dnf'_eval[OF the_real_step_augment[OF gen_qe_eval, of "λx _ _. x"] opt] using opt VSLuckiestBlocks by fastforce theorem VSLuckyBlocks : "∀xs. eval (VSLuckyBlocks φ) xs = eval φ xs" unfolding VSLuckyBlocks_def Unpower_def opt_group_def using QE_dnf'_eval[OF the_real_step_augment[OF luckyFind'_eval, of "λx _ _. x"] opt] using opt VSLuckiestBlocks by fastforce theorem VSLEGBlocks : "∀xs. eval (VSLEGBlocks φ) xs = eval φ xs" unfolding VSLEGBlocks_def opt_group_def using VSEqualityBlocks VSGeneralBlocks VSLuckyBlocks by fastforce theorem VSEqualityBlocksLimited : "∀xs. eval (VSEqualityBlocksLimited φ) xs = eval φ xs" unfolding VSEqualityBlocksLimited_def Unpower_def opt_group_def using QE_dnf_eval[OF qe_eq_repeat_eval_augment opt] opt VSLuckiestBlocks by fastforce theorem VSEquality_3_times : "∀xs. eval (VSEquality_3_times φ) xs = eval φ xs" using VSEquality unfolding VSEquality_3_times_def by auto theorem VSGeneral: "∀xs. eval (VSGeneral φ) xs = eval φ xs" unfolding VSGeneral_def Unpower_def Unpower_def opt_def using QE_dnf_eval[OF gen_qe_eval' opt_no_group] using opt_no_group VSLuckiest by fastforce theorem VSGeneralBlocksLimited: "∀xs. eval (VSGeneralBlocksLimited φ) xs = eval φ xs" unfolding VSGeneralBlocksLimited_def Unpower_def opt_group_def using QE_dnf_eval[OF gen_qe_eval_augment opt] opt VSLuckiestBlocks by fastforce theorem VSBrowns: "∀xs. eval (VSBrowns φ) xs = eval φ xs" unfolding VSBrowns_def Unpower_def opt_group_def using QE_dnf_eval[OF step_augmenter_eval[of gen_qe brownsHeuristic, OF gen_qe_eval brownHueristic_less_than] opt] opt VSLuckiestBlocks by fastforce theorem VSGeneral_3_times : "∀xs. eval (VSGeneral_3_times φ) xs = eval φ xs" unfolding VSGeneral_3_times_def using VSGeneral by auto theorem VSLucky: "∀xs. eval (VSLucky φ) xs = eval φ xs" unfolding VSLucky_def Unpower_def opt_def using QE_dnf_eval[OF luckyFind_eval' opt_no_group] opt_no_group VSLuckiest by fastforce theorem VSLuckyBlocksLimited: "∀xs. eval (VSLuckyBlocksLimited φ) xs = eval φ xs" unfolding VSLuckyBlocksLimited_def Unpower_def opt_group_def using QE_dnf_eval[OF luckyFind_eval_augment opt] opt VSLuckiestBlocks by fastforce theorem VSLEG: "∀xs. eval (VSLEG φ) xs = eval φ xs" unfolding VSLEG_def using VSLucky VSEquality VSGeneral by auto theorem VSHeuristic : "∀xs. eval(VSHeuristic φ) xs = eval φ xs" unfolding VSHeuristic_def Unpower_def opt_group_def using QE_dnf_eval[OF superPicker_eval opt] opt VSLuckiestBlocks by fastforce theorem VSLuckiestRepeat : "∀xs. eval (VSLuckiestRepeat φ) xs = eval φ xs" unfolding VSLuckiestRepeat_def using repeatAmountOfQuantifiers_eval[OF] using VSLuckiest by blast export_code print_mpoly VSGeneral VSEquality VSLucky VSLEG VSLuckiest VSGeneralBlocksLimited VSEqualityBlocksLimited VSLuckyBlocksLimited VSGeneralBlocks VSEqualityBlocks VSLuckyBlocks VSLEGBlocks VSLuckiestBlocks QE_dnf gen_qe qe_eq_repeat simpfm push_forall nnf Unpower is_quantifier_free is_solved add mult C V pow minus Eq Or is_quantifier_free real_of_int real_mult real_div real_plus real_minus VSGeneral_3_times VSEquality_3_times VSHeuristic VSLuckiestRepeat VSBrowns in SML module_name VS end